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LINEAR  ALGEBRA  USING  PASCAL  MT+ 


Introduction  to  Linear  Algebra  Calculator 


This  program  solves  the  two  major  problems  of  linear 
algebra;  (1)  the  determination  of  the  eigenvalues  and 
eigenvectors  of  a  square  matrix  "A"  and  (2)  the  solution  of 
simultaneous  equations  "A  X  =  B"  for  an  n  by  n  invertible  matrix 
"A"  and  any  n  by  m  matrix  “B" .  One  must  use  the  built-in  matrix 
editor  to  enter  the  matrices  “A"  and  "B“.  A  program  ,  based  on 
eigenvalues  of  a  companion  matrix,  to  calculate  the  roots  of  a 
polynomial  with  real  coefficients  is  also  included.  The  source 
code  of  the  mathematical  routines  and  I/O  routines  could  be  used 
to  build  a  more  elaborate  matrix  calculator  that  might  include 
disk  I/O,  a  more  flexible  editor,  addition  and  multiplication  of 
matrices,  and  a  matrix  expression  evaluator.  This  program  does 
not  have  these  capabilities. 

Tile  hardware  configuration  necessary  to  run  this  program  is 
an  IBM  PC  with  I28K  of  RAM  memory  and  one  double-sided  drive.  It 
is  written  in  Pascal  MT+  and  thus  the  source  code  could  be 
compiled  with  any  MT+  compiler  after  making  a  few  modifications 
to  the  system  I/O  routines.  Depending  upon  what  floating  point 
library  is  linked  in  with  the  compiled  code,  the  program  may  be 
run  with  an  8087  chip  or  an  8088  chip. 

To  run  the  program  one  may  do  any  one  of  the  following;  (1) 
if  the  machine  is  off,  insert  the  progam  diskette  in  drive  A  and 


turn  the  power  on;  CPM-86  will  be  loaded  and  the  program,  called 
MATRIX,  will  be  executed;  (2)  if  the  machine  is  on,  insert  the 
diskette  in  drive  A  and  do  a  warm  boot  by  pressing  "Ctrl-Alt-Del" 
simultaneously;  CPM-86  will  be  loaded  and  the  program  will  be 
executed;  or  (3)  if  CPM-8b  has  been  loaded,  insert  the  diskette 
in  drive  A,  make  tlie  CPM  prompt  say  A>,  and  key  in  MATRIX 
followed  by  carriage  return.  There  are  obviously  other 
possibilities.  The  program  and  all  its  overlays  could  be 
transferred  to  RAM  disk  M  and  executed  from  there  with  M  also  the 
default  drive.  One  must  always  have  the  program  and  its  overlays 
on  the  default  drive  because  the  program  looks  for  its  overlays 
on  the  default  drive. 

Brief  instructions  on  how  to  use  the  program  will  now  be 
given.  When  the  program  is  executed,  the  main  menu  is  displayed. 
By  pressing  "G",  one  can  view  some  very  brief  instructions.  They 
are  intended  for  somebody  who  has  never  run  the  program  before  or 
who  does  not  like  to  read  documentation.  Before  doing  any  matrix 
work,  one  must  press  "F"  to  bring  up  the  matrix  editor  and 
displayer.  The  menus  are  self-explanatory  and  channel  the  user  in 
the  desired  directions.  To  do  matrix  work  one  must  enter  a  matrix 
"A"  but  the  entering  of  "B"  is  only  necessary  for  solving  "AX  = 
B".  Only  one  matrix  "A"  and  one  matrix  "B"  may  be  stored  at  a 
time.  To  enter  a  new  matrix  after  one  has  already  been  created 
one  must  answer  "Y"  to  the  erase  prompt. 

When  matrices  "A"  and  "B"  are  first  created,  they  are 
initialized  at  all  zeros.  The  user  then  edits  the  matrix  in 
increasing  column  order.  Each  column  will  be  displayed  for 


editing.  If  one  answers  "Y”  to  the  column  correct  prompt,  then 
the  next  column  will  be  displayed  for  editing.  If  one  answers 
"N",  the  cursor  will  be  positioned  at  the  entry  in  the  first  row 
of  that  column.  If  one  wants  to  change  that  entry,  he  enters  a 
now  number  followed  by  return.  If  one  simply  enters  return,  the 
entry  is  not  changed  and  the  cursor  is  positioned  at  the  next 
row.  After  the  entire  column  has  been  edited,  the  column  is 
redisplayed  witli  the  same  prompt.  To  edit  column  4,  one  is  forced 
to  first  view  and  answer  "Y“  to  the  first  three  column  correct 
prompts.  A  compromise  on  flexibility  and  editing  speed  for  user 
friendliness  and  less  progranuning  has  been  made  here. 

Once  “A"  has  been  entered,  one  may  return  to  the  outer  menu 
to  calculate  the  inverse,  determinant,  eigenvalues,  and 
eigenvectors.  If  "B"  has  been  entered  also,  one  can  press  "C"  to 
solve  a  linear  system  "A  X  =  B”.  One  can  solve  for  the  roots  of  a 
polynomial  by  pressing  "A".  One  enters  the  coefficients  of  the 
polynomial  within  this  segment  of  the  program,  not  in  the 
editor . 

Two  possible  I/O  problems  are  the  following:  (1)  real  numbers 
are  not  filtered  for  underflow  or  overflow  when  inputted;  they 
have  to  be  entered  in  the  interval  Cl*y  E-3iJ7,  1.0  E+307];  and 
(2)  the  printer  must  be  on-line  (  or  must  be  put  on-line  when  the 
CFM-86  error  message  is  displayed)  if  a  hardcopy  is  desired.  If 
one  cannot  get  the  printer  on  line  after  a  hardcopy  was 
requested,  CPM-86  exits  the  user  back  to  a  system  prompt  and  the 


An  example  matrix  “A"  to  key  in  is  :  column  1  is  the  vector 
(1,3,6),  column  2  is  the  vector  (-3, -5, -6),  and  column  3  is  the 
vector  (3,3,4).  Let  X  and  r  (not  variables  in  the  Program  Matrix) 
stand  for  the  associated  eigenvector  and  eigenvalue  in  the 
equation  "AX=rX" .  The  eigenvalues  of  “A”  are  4,-2,  -2  and  the 
associated  eigenvalues  are  respectively  (1,1,2),  (-1,1,2)  and 
(1,3,2).  It  should  be  noted  that  eigenvectors  returned  by  the 
calculator  will  differ  by  scalar  multiples  from  those  above. 
Also,  keep  in  mind  instead  of  (-1,1,2)  and  (1,3,2)  which  are 
associated  with  the  eigenvalue  -2,  we  could  have  another  pair  of 
eigenvectors  such  as  (0,4,4)  and  (2,2,0)  which  are  in  the  same 
eigenspace  as  the  first  pair.  The  inverse  of  the  matrix  "A"  is 
the  matrix  whose  columns  are:  (1)  . 125 (-1 , 3 , 6 ) ,  (2)  .125(-3,-7,- 
6),  and  (3)  .125(3,3,2).  This  matrix  has  16  as  its  determinant. 
Tile  polynomial  X** 3-6X**2+l lX-6  would  be  entered  as  the  vector 
( 1 , -6 , 1 1 , -6 ) .  It  has  roots  1,2,3. 


Description  of  CRT  and  keyboard  utilities 

The  utility  programs  in  Module  CRTLIB  are  for  cursor 
control  and  filtered  input  of  characters,  integers,  and  real 
numbers.  This  section  should  be  read  concurrently  with  the  source 
listing  of  Module  CRTLIB.  These  routines  are  based  upon  two  CPM- 
86  BIOS  »  ills,  which  are  implemented  in  the  Procedure  Bioscall. 
Bioscall  has  two  input  parameters;  (1)  FUNC,  a  variable  of  type 
CPMOPERATION  and  (2)  OCH,  an  integer  variable.  Bioscall,  as 


presented  here,  only  responds  to  two  inputs,  CONIN  and  CONoUT,  of 


type  CPMOPERATION. 


In  the  following,  terminal  character  refers  to  a  character 
that  is  being  sent  to  the  monitor  to  effect  a  cursor  control.  To 
send  a  terminal  character  to  tlie  CRT  inter  face  ( monitor ) ,  one 
calls  Bioscall  with  input  parameters  FUNC  equal  to  CONOUT  and  OCH 
equal  to  the  ASCII  number  of  the  terminal  character.  The  value  of 
the  variable  BDOSVAL( integer  global  to  Module  CRTLIB)  is  not  used 
explicitly;  here  it  is  used  only  to  call  Procedure  @BDOS86.  To 
read  a  character  from  the  keyboard,  one  calls  Bioscall  with  input 
parameters  FUNC  equal  to  CONIN  and  OCH  equal  to  any  dummy 
integer.  The  global  variable  BDOSVAL  is  set  equal  to  the  ASCII 
number  of  the  keyboard  character  pressed.  The  number  50  in 
@BDOS86(50,  ADDR{ DESCRIPTL 1 J ) )  is  the  BOOS  function  number  for  a 
BIOS  call.  The  five  consecutive  bytes  allocated  by  DESCRIPT  are 
used  for  passing  information  in  the  @BD0S86  call.  For  example, 
"DESCRI PT[ 1 ] : =4”  is  the  Pascal  line  for  console  display  while 
"DESCRIPTLI 3 : =3"  is  the  line  for  keyboard  input.  The  Pascal  MT+ 
manual  gives  a  brief  description  of  the  MT+  utility  @BDOS86  while 
the  CPM-80  manual  gives  a  detailed  discussion  of  BDOS  calls  in 
its  Appendix  D.  The  Procedure  Bioscall  presented  here  is  a  Pascal 
implementation  combining  @BDOS86  with  the  BDOS  calls (for  function 
number  ad)  of  CPM-86 . 

One  could  expand  Procedure  Bioscall  to  include  all  the 
parameters  in  CPMOPERATION  by  combining  the  ideas  in  Bioscall 
witli  Appendix  D  of  the  CPM-S6  manual.  One  does  not  need  to  use 
Bioscall  to  write  an  alpha-numeric  character  to  the  screen;  Write 
or  Writeln  can  be  used  for  this.  Most  of  the  routines  in  Module 


CRTLia  cither  call  Bioscall  or  another  routine  which  calls 
liioscull.  Function  Getchar  is  the  only  procedure  that  calls 
Uioscall  with  the  CONIN  parameter. 

In  order  to  use  the  utilities  in  Module  CRTLIB  one  must  call 
Procedure  Crtinit  at  the  beginning  of  the  main  program.  Crtinit 
ir»itiaiizes  the  arrays  CRTINFO  and  PREFIXED  so  that  their  values 
can  be  used  by  the  utilities  in  Module  CRTLIB. 

Function  Getchar,  using  Bioscall,  performs  the  task  of 
reading  a  character  from  the  keyboard.  The  input  to  Getchar  is  a 
variable  set  of  characters,  called  OKSET  in  Getchar ’ s 
declaration.  V^hen  Bioscall  is  called  by  Getchar  to  get  a 
character  from  the  keyboard,  Getchar  then  checks  to  see  if  the 
character  represented  by  BDOSVAL  is  in  OKSET.  If  it  is,  this 
cliaracter  becomes  the  value  of  the  Function  Getchar  and  is  used 
in  the  procedure  calling  Getchar;  if  it  is  not,  a  beep  is  sounded 
and  the  process  is  repeated  until  a  character  in  OKSET  is  finally 
entered.  This  version  of  Getchar  automatically  changes  lower  case 
to  upper  case.  An  example  of  Getchar  being  used  with  OKSETs  that 
are  dynamically  changing  can  be  seen  in  Procedure  Getreal. 


Procedure  Crt  is  the  main  routine  that  calls  Procedure 
Bioscall  with  the  CONOUT  parameter.  Depending  on  the  boolean 
value  given  by  an  element  in  the  array  PREFIXED,  the  leadin 
character,  ESC,  is  sent  to  the  monitor  and  then  the  actual 
terminal  character  is  sent  to  the  monitor.  For  example,  suppose 
we  want  to  clear  the  screen.  One  uses  the  variable  ERASEOS  of 
type  CRTCOIIMAND  as  the  parameter  input  to  Procedure  Crt.  Using 


EKASEOS  as  the  index  variable,  Crt  sends  the  ieadin  cViaracter 
ESC  to  the  monitor  since  PREF1XED[ERASE0S ]  is  true  and  then  sends 
the  character  'J',  whicli  is  CRTINFO[ERASEOS  ] .  It  should  be  noted 
that  in  the  above,  the  ASCII  numbers  of  the  various  characters 
are  actually  inputted  to  Bioscali  in  Procedure  Crt. 

One  can  control  background  colors  by  using  the  type  COLOR, 
the  arrays  COLORIhFO,  CRTINFO,  and  PREFIXED  along  with  the 
Procedures  Initcolor,  Altcolor,  and  Paint.  One  then  needs  to 
write  u  procedure  similar  to  Altcolor  to  change  foreground 
colors.  These  would  be  the  fundamental  library  routines  for  using 
colors . 

Procedure  Gotoxy ( X , Y ; INTEGER ) ,  which  also  calls  Bioscali 
with  input  parameter  CONOUT,  places  the  cursor  at  vertical  line 
number  X  and  horizontal  line  number  Y.  The  other  cursor  control 
routines  are  fairly  obvious  in  view  of  the  above  discussion. 

Procedure  Intread  is  used  to  read  an  integer  between  -32768 
and  +32707.  The  characters  are  filtered,  put  into  a  string, 
checked  for  the  proper  range,  and  then  converted  to  an  integer. 
Ititread  requires  an  integer  to  be  entered;  one  cannot  simply 
enter  carriage  return.  Procedures  Getreal  and  Value  are  used 
together  to  read  a  real  number.  Some  explanation  is  required  on 
tlie  use  of  Getreal.  In  the  procedure  calling  Getreal,  we  have  a 
string  variable,  SREEL,  initialized  at  an  empty  string  of 
lengtyi  zero  but  still  a  string.  Procedure  Getreal  reads  and 
dyruiiaica  1  ly  filters  a  string  of  characters  and  if  this  string  is 
of  length  greater  than  zero,  this  string  is  returned  to  the 

7 


calling  procedure  by  Getreal  and  SREEL  is  set  equal  to  it.  If 


Getreal  only  reads  a  carriage  return,  then  SREEL  remains  only  an 
empty  string  and  Procedure  Value  is  not  called.  If  SREEL  has 
length  greater  than  zero.  Procedure  Value  calculates  the  real 
number  corresponding  to  SREEL.  Getreal  and  Value  are  used  to  edit 
a  real  number  that  already  exists,  either  through  initialization 
or  calculation.  By  pressing  carriage  return,  one  can  leave  an 
existing  real  number  as  is.  This  use  eliminates  a  computer  crash 
caused  by  keying  in  only  a  carriage  return  when  the  usual  READ  or 
READLN  wants  an  actual  number.  Procedure  Value  was  taken  from  The 
Byte  Book  of  Pascal  while  Procedure  Powrten  is  from  the  Pascal 
Users  Manual  by  Jensen  and  Wirth. 


Data  and  Overlay  Description 

This  program  illustrates  the  use  of  module  overlays,  an 
ordinary  module,  matrix  types  and  external  variables.  This 
description  explains  the  manner  in  which  the  program  was 
implemented,  and  therefore  it  should  be  used  as  a  guide  to 
understanding  the  structure  of  the  code.  Modules  are  separately 
compiled  groups  of  procedures.  There  are  two  types:  11)  an 
overlay  module  and  (2)  an  ordinary  module  which  must  be  linked 
with  an  overlay  module  or  main  program.  The  Module  CRTLIB  is 
separately  compiled  and  linked  in  with  the  main  program.  CRTLIB 's 
subroutines  essentially  become  a  part  of  the  main  program( 
sometimes  called  the  root  overlay)  and  always  are  resident  in  RAM 
memory.  Since  the  utilities  in  CRTLIB  are  continually  being 


B 


called,  it  would  not  bo  practical  to  make  CRTLIB  an  overlay 
module  and  thus  force  a  lot  of  disk  accesses.  If  a  module 
overlay {  including  the  main  program)  uses  a  procedure  in  Module 
CRTLIB,  then  the  "calling"  overlay  must  declare  the  procedure  as 
an  external  procedure  in  the  calling  overlay's  declaration 
heading  just  below  the  variable  declarations. 

The  data  storage  of  the  program  will  now  be  explained.  The 
controlling  data  allocation  declarations  are  (1)  the  TYPE 
DOMAIN  1  =  1 ..  20,  (2)  the  CONST  (•1AXDEG=20,  (3)  the  CONST 
MAXDEGP1=21,  and  (4)  the  TYPE  D0MRPI=1 . . MAXDEGPl .  MAXDEG, 
MAXDEGPl {=MAXDEG  PLUS  1),  and  DOMRPl  are  used  to  solve  for  roots 
of  a  polynomial.  DOMAINl  is  the  maximum  dimension  of  a  matrix 
entered  as  input  data.  MAXDEG  should  be  set  to  be  less  than  or 
equal  to  the  value  of  the  DOMAINl  upper  bound  since  the 
polynomial  root  finding  technique  uses  an  n  by  n  matrix  to  solve 
an  n  degree  polynomial  equation.  In  this  program,  the 
coefficients  of  a  polynomial  are  not  stored  in  a  global  variable( 
for  the  main  program)  and  there  is  not  much  I/O  to  go  with  the 
polynomial  routine.  It  is  included  as  a  side  benefit  to 
illustrate  the  use  of  the  eigenvalue  procedures  as  subroutines  to 
another  procedure.  Variables  that  are  referred  to  as  global  are 
declared  in  the  main  program  and  then  declared  external  in  the 
overlays  that  use  them.  The  matrix  "A"  whose  square  dimension 
is  lONDIM  is  stored  in  the  upper  left-hand  corner  of  the  global 
variable  IOTA  and  the  matrix  "B"  whose  dimension  is  ROWDIMB  by 
lOM  is  stored  intho  upper  left-hand  corner  of  the  global  variable 
lOTB.  IOTA,  lOTB,  lONDIM,  ROWDIMB,  and  lOM  are  declared  in  the 


root  overlay {  Program  Matrix)  and  referenced  in  the  appropriate 
overlays  by  declaring  them  as  external  variables.  The  global 
matrix  "XX"  is  used  to  store  the  solution  to  "AX=B"  and  is 
referenced  as  external  in  Module  Overlay2U(  whose  source  code  is 
AXEUSB.SRC).  The  global  vectors  TEVR,  TEVI  store  the  real  and 
imaginary  components  of  the  eigenvalues  and  are  referenced  as 
external  in  Module  Overlay24(  EIGENVEC . SRC ) .  The  global  matrix 
TVEC,  referenced  as  external  in  Module  Overlay24,  is  used  to 
store  the  eigenvectors  of  the  matrix  "A".  Communication  of  data 
between  the  root  overlay  (Program  Matrix)  and  the  overlay 
modules  I J, #19, #20, #24  is  accomplished  by  initially  declaring  the 
above  mentioned  variables  in  the  main  program  and  by  declaring 
them  external  in  the  necessary  overlay  modules.  The  Types  of 
matrices  and  vectors  must  be  declared  in  the  root  overlay  and 
redeclared  in  the  overlay  modules.  When  using  dimensions  less 
than  the  maximum  allocated  in  the  Types,  all  data  will  be  stored 
in  the  upper  left-hand  corner  of  matrices  or  beginning  components 
of  a  vector.  Intermediate  results  produced  by  Module  Overlayl 
(LINSYS.SRC) ,  Module  Overlays  ( EIGENllOR.  SRC  )  ,  and  Module  OverlayG 
( EIGENBAL . SRC )  are  passed  as  parameters  in  the  procedure  calls. 

The  root  overlay  (Program  Matrix)  calls  directly  six  main 
procedures  located  in  six  overlays.  They  are  (1)  Procedure 
Matrixio,  located  in  Module  Overlays,  which  is  the  editor  for 
matrix  input,  (2)  Procedure  Help,  located  in  Module  Overlay23, 
which  is  a  brief  set  of  instructions  on  how  to  run  the  program, 
(3)  Procedure  Ttrdet,  located  in  Module  0verlayl9,  which 
calculates  the  determinant  of  the  matrix  stored  in  variable  IOTA, 


(4)  Procedure  Ttsaxb,  located  in  Module  Overlay20,  which  solves 
"AX=Q"  for  "A"  stored  in  the  variable  IOTA  and  "B"  stored  in  the 
variable  lOTB  or  "B"  is  the  identity  matrix!  used  to  calculate 
the  inverse  of  "A"),  (5)  Procedure  Ttrnaa,  located  in  Module 
Overlay24,  which  calculates  eigenvectors  and  eigenvalues  of  the 
matrix  stored  in  IOTA,  and  (6)  Procedure  Ttrpqr,  located  in 
Module  Overlay21,  which  calculates  the  roots  of  a  polynomial  with 
real  coefficients.  These  six  procedures  which  are  located  in 
module  overlays  must  be  declared  external  in  the  root  overlay 
heading.  After  the  word  "External",  the  overlay  number  to  which 
the  procedure  belongs  must  appear  in  square  brackets. 

Other  external  procedures  used  within  these  overlays  do  not 
have  to  be  declared  within  the  root  overlay;  they  are  declared  as 
external  procedures  with  the  appropriate  overlay  numbers  within 
the  overlay  that  calls  them.  For  example.  Procedure  Ttrdet, 
located  in  Overlay  Modulel9,  calls  Procedure  Rlud,  located  in 
Overlay  Modulel .  Therefore,  Procedure  Rlud  must  be  declared 
external  in  the  heading  of  Module  Overlayl9.  Module  Overlay!  uses 
procedures  located  in  the  Module  CRTLIB(  not  an  overlay  module), 
ana  therefore  these  called  procedures  must  be  declared  as 
external  in  the  heading  of  Module  Overlay!.  These  external 
procedures  from  Module  CRTLIB  do  not  have  overlay  numbers. 

Module  Overlay!  ( lOMATRIX . SRC)  is  the  module  responsible  for 
keyboard  input  of  matrices  and  printer  output  of  matrices.  The 
maximum  size  of  the  matrix  is  set  in  the  TYPE  DOMAINl  =  1..20.  If 
one  wanted  only  matrices  of  dimension  10  or  less,  one  would  set 
TYPE  DOI*lAINl  =  1..10.  One  must  change  these  type  declarations  for 


all  the  overlays  that  use  them.  It  should  bo  noted  that  the 
editing  programs  are  based  upon  editing  a  column  of  a  matrix  that 
fits  onto  one  screen  display.  If  one  wanted  to  enter  a  column  of 
dimension  larger  than  twenty,  the  column  display  and  editing 
routines  would  have  to  be  modified  a  little.  On  the  other  hand  it 
is  not  practical  to  enter  a  matrix  larger  than  10  by  10,  let 
alone  20  by  20.  Large  matrices  should  be  generated  by  a  program 
or  read  from  a  disk  file.  For  example.  Module  Polyroot  generates 
a  20  by  20  matrix  when  one  requests  the  root  of  X**2U=1. 

Within  this  module.  Procedure  Getcolumn  and  Procedure 
Gotpolcof  are  the  work  horses.  Respectively,  they  take  the  column 
of  a  matrix  or  the  coefficients  of  a  polynomial  and  display  them 
on  the  screen  for  editing.  These  two  routines  use  the  cursor 
control  utilities  and  Procedures  Intread,  Getreal,  and  Value  to 
edit  existing  columns.  Procedure  Matrixio  is  the  editing 
procedure  which  calls  the  Procedures  Edit  and  Display.  Edit 
displays  menus,  initializes  matrices,  and  calls  the  above 
mentioned  procedures  to  edit  existing  matrices.  Procedure 
Display,  which  is  somewhat  redundant,  gives  a  faster  display  than 
Procedure  Edit.  Procedure  hardcopy  is  used  to  printout  the 
matrices  "A",  "B",  inverses,  determinants,  matrix  equation 
solutions,  eigenvectors,  and  eigenvalues. 

Module  Overlay24  (EIGENVEC.SRC) ,  Module  OverlayG 
(EIGENBAL.SRC) ,  and  Module  Overlays  ( EIGENHQR . SRC)  are  the 
overlays  which  calculate  eigenvectors  and  their  corresponding 


eigenvalues.  Procedure  Ttrnaa  takes  the  global  matrix  IOTA 


containing  the  matrix  "A"  and  its  dimension,  lOtJDIM,  and  calls 
the  Procedure  Knaa.  Procedure  Rnaa  is  the  procedure  which  calls 
the  Procedures  Balance,  Elmhes,  Eltran,  Hqr2,  and  Balbak,  which 
together  calculate  the  eigenvalues  and  eigenvectors.  The 
eigenvalues  are  returned  to  Ttrnaa  in  the  global  arrays  TEVR  and 
TEVI.  TEVR[l]  and  TEVltl]  give  the  real  and  imaginary  parts  of 
tlie  eigenvalue  #1.  The  eigenvectors  are  returned  in  the  matrix 
TVEC  in  a  not  so  obvious  way.  They  are  returned  in  an  order 
corresponding  to  the  eigenvalues  in  TEVR  and  TEVI .  The  manner  in 
which  TVEC  returns  the  eigenvectors  needs  to  be  illustrated  by  an 
example.  Let  TEVR[lJ=l  and  TEVlCl]=2;  the  eigenvalue  is  l+2i. 
Then  TEVR[2]=i  and  TEVlC23=-2  since  eigenvalues  and  eigenvectors 
of  real  matrices  occur  in  conjugate  pairs.  Now  the  two 
eigenvectors  that  correspond  to  these  eigenvalues  are  conjugates. 
TVEC  in  its  first  column  will  have  the  real  part  of  eigenvector 
#1  and  in  its  second  column  it  will  have  the  imaginary  part  of 
eigenvector  #1.  Eigenvector  #2  will  just  be  the  conjugate  of  this 
eigenvector.  If  the  eigenvalue  is  pure  real,  then  the  eigenvector 
is  pure  real  and  only  one  column  is  necessary.  In  the  case  of  a 
matrix  with  repeated  eigenvalues  without  a  full  set  of 
eigenvectors,  the  eigenvectors  will  be  repeated  in  the  matrix 
TVEC(  probably  numerically  slightly  different).  These  eigenvector 
subroutines  are  Pascal  translations  by  the  author  of  EISPACK 
eigenvector  routines  in  Fortran. 

Module  Overlay21  I  POLY ROOT . SRC )  also  uses  the  eigenvalue 
subroutines  to  solve  for  the  roots  of  a  polynomial  with  real 
coefficients.  It  makes  the  integer  1  the  leading  coefficient  of  a 


polynomial  of  degreo  n  and  outers  the  other  n  coefficients  into 
the  first  row  of  an  n  by  n  matrix  with  l*s  on  the  subdiagonal; 
this  matrix  is  called  the  companion  matrix  and  the  eigenvalues  of 
it  are  the  roots  of  the  polynomial.  Procedure  Ttrpqr  does  the 
preliminaries  and  Procedure  Rpqr  calls  the  sequence  of  eigenvalue 
subroutines  to  find  the  eigenvalues  which  are  returned  in  the 
variables  TWR  and  TWI .  Procedure  Balbak  is  not  used  since  the 
eigenvectors  are  not  needed.  POLYROOT. SRC  illustrates  the  use  of 
these  subroutines  in  a  real  problem  and  it  also  serves  as  a  test 
of  the  correctriess  of  the  eigenvalue  codes. 


^  ".A*--? 


Module  Overlay2d  (AXEOSD.SRC)  and  Module  Overlayl 
(LINSYS.SRC)  are  the  overlays  which  solve  systems  "AX=B"  as  well 
as  find  the  inverse  of  the  matrix  "A*'  (B  will  be  the  identity 
matrix  in  this  case).  Again  the  ''A"  matrix  is  in  IOTA  and  the  "B" 
matrix  is  in  lOTB.  Procedure  RLUD  does  an  L-U  decomposition  on 
the  matrix  in  the  variable  SA(  the  constant  matrix  B  tags  along) 
and  Procedure  Rfbs  does  the  back  substitution  to  solve  the 


system.  In  the  case  where  "D"  has  more  than  one  column,  Rfbs  is 
called  lOM  times  to  solve  the  equations.  Procedures  Rlud  and  Rfbs 
are  Pascal  translations  by  the  author  of  a  Sandia  Labs  matrix 
equation  solver;  it  is  very  successful  with  matrices  "A"  that  are 
almost  singular(no  inverse). 

Module  Overlayl9  (DETERM. SRC)  and  Module  Overlayl 
(LINSYS.SRC)  are  used  to  calculate  determinants.  Rlud  in 
LINSYS.SRC  does  an  L-U  decomposition  of  the  matrix  TALU (  a  copy 
of  loTA)  and  returns  the  L-U  decomposition  itj  TALU.  The  matrix  L 


h.is  ones  on  the  diagonal  and  therefore  the  ileterminant  of  “A" 
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will  be  the  determinant  of  “U"  which  is  just  the  product  of  U*s 
diagonal  etitries. 


Layout  of  Overlays 


Module  overlays  are  divided  into  groups.  Overlays  #1  -#16 
are  in  overlay  group  #1,  overlays  #17-#32  are  in  overlay  group 
#2,  etc..  The  source  code  of  an  overlay  module  must  begin  with 
its  identification  number;  for  example  overlay  module  #1  l,..s  the 
heading,  Module  Overlayl.  The  root  overlay  is  just  the  main 
program;  here  it  is  Program  Matrix.  This  program  does  not  use  the 
most  sophisticated  overlay  structure.  In  this  program,  overlays 
Within  the  same  group  do  not  call  each  other  and  there  is  no 
heap.  When  compiling  an  overlay,  one  does  not  have  to  specify  the 
address  in  RAM  memory  where  the  overlay  will  be  loaded.  This  is 
done  during  the  linking  process.  All  the  overlays  within  the  same 
group  must  be  located  at  the  same  address.  This  address  must  bo 
larger  than  the  length  of  the  root  overlay  including  any  runtime 
library  routines  or  ordinary  modules  linked  with  the  root 
overlay.  For  example,  the  root  overlay.  Program  Matrix  with 
routines  from  the  libraries  TRANCEND . Rbb ,  b7REALS.Rb6, 
PASLlB.Rb6,  and  Module  CRTLIU  use  OFFCll(hex)  bytes  of  storage. 
The  memory  allocated  for  overlay  group  #1  must  be  some  address 
larger  than  this;  here  bOdOll  is  used-  In  the  linking  instructions 
below,  overlays  #1  -  #16  must  be  directed  to  begin  at  86U011.  Then 
one  looks  at  the  largest  length  of  the  compiled  overlays  in  group 
#1  and  adds  this  to  B60JH.  in  this  program.  Module  Overlays  has 
length  42A/\H.  This  should  be  verified  again  after  all  the 


overlays  in  group  #1  have  been  linked  to  the  root  overlay.  One 
adds  bbdJH  to  42AAH  to  obtain  the  length  C8AAH .  The  address  where 
overlays  #17  -  #32  begin  must  be  larger  than  C8AA11.  This  program 
uses  address  D200H  for  the  location  of  overlays  in  group  #2.  The 
overlay  of  the  largest  length  in  group  #2  is  Module  0verlay21 
with  a  length  of  1370ri.  1370H  plus  D200H  equals  E570H.  Therefore, 
tl»e  total  length  of  the  code  that  must  be  specified  in  the  last 
link  command  with  the  R  switch  must  be  greater  than  E570H.  The 
value  used  is  FC00H.  The  data  storage  required  is  only  that  from 
those  variables  declared  in  the  main  program  and  it  is  576CH. 
The  value  BU0011  is  more  than  adequate  and  is  declared  with  the  D 
switch  in  the  last  linker  command.  Local  variables  and  parameters 
are  stored  in  the  stack.  Tliis  stack  is  automatically  given  32K 
bytes  of  RAM.  One  can  actually  assign  the  stack  size  by  using  the 
Z  switch  in  the  last  linker  command.  For  example,  "Z/30U"  will 
assign  30U0H  for  stack  memory.  Note  that  300  here  means  3000H  or 
i2K  bytes. 


One  lias  to  make  sure  the  total  RAM  allocated  for  data,  code, 
stack,  and  heap  is  smaller  than  the  RAM  allocated  for  program 
execution.  Otherwise,  upon  program  execution,  a  "Memory  not 
available"  message  will  be  displayed.  In  this  program,  the  stack 
was  reduced  to  12K  in  order  that  the  program  would  execute  in  a 
12dK  machine.  Having  a  stack  too  small  is  a  potential  problem, 
but  by  far  the  major  source  of  problems  is  having  one  overlay 
group  overwrite  another.  Apparently,  one  needs  to  have  some 
memory  available  between  the  end  of  the  largest  overlay  in  a 
particular  group  (including  the  root  overlay)  and  the  beginning 


of  the  next  overlay  group.  For  example,  in  this  program  when  the 
addresses  7200H,  B80OH,  and  DEOOH  were  used  in  place  of  the 
addresses  860011,  D200U,  and  FC00H  the  program  would  not  execute 
properly.  The  Pascal  MT+  manual  should  address  this  problem.  If 
one  experiences  weird  program  execution,  the  distance  between 
overlay  groups  should  be  increased  as  the  first  approach  to  solve 
the  problem. 

Computer  Configuration  for  Pascal  MT+ 

In  doing  developmental  work  for  this  program,  the  IBM  PC  was 
configured  with  two  DS/UD  disk  drives,  512K  of  RAM,  and  the  CPM- 
86  operating  system.  The  RAM  was  partitioned  into  140K  for 
running  programs (compiler ,  editor,  linker,  and  the  executable 
linear  algebra  routine)  and  J72K  for  a  RAM  disk,  called  the  M: 
drive.  The  program  SETUP.CMD,  furnished  with  CPM-86,  was  used  to 
configure  the  RAM  drive  and  the  cursor  pad  of  direction  arrows. 
Upon  bootup,  the  RAM  drive  is  created  and  the  cursor  pad  is 
initialized. 

A  RAM  disk  is  essential  (though  not  required)  for  program 
development  with  Pascal  MT+  because  of  the  heavy  disk  access  by 
the  MT+  Speed  Editor,  Compiler,  and  Linker  of  their  overlays  and 
the  program's  source  and  object  code  files.  If  one  follows  the 
implementation  techniques  described  in  the  following,  the  user 
will  find  MT+  not  just  a  powerful  Pascal  implementation,  but  one 
that  possess  good  development  time  and  is  not  cumbersome.  It 
should  be  mentioned  that  in  many  articles  comparing  the  MT+ 


implomentation  to  others,  the  benchmarks  involving  compile  and 
link  times  are  misleading.  Pascal  MT+  uses  a  lot  of  disk  l/O 
because  of  its  code  size  and  this  eats  up  a  lot  of  time.  Using  a 
RAM  disk  reduces  this  l/O  time  considerably. 

One  must  configure  three  diskettes.  Diskette  #1,  called  the 
compiler  diskette,  must  contain  CPM.SYS(  configured  for  RAM  drive 
and  optionally  the  cursor  pad),  the  MT+  compiler(  consisting  of  a 
CMD  file  and  its  several  overlays),  and  three  RB6  files:  (1) 
87REALS.RU6,  (2)  PASLIU . RUb , and  (3)  TRAUCRND . R86 .  It  is  optional, 
but  useful  to  put  the  utility  routines  such  as  PIP. CMD  and 
STAT.CMD  on  the  compiler  diskette.  Diskette  #2,  called  the  editor 
diskette,  should  contain  tlie  Speed  Programmming  Editor(  CMD  file 
and  its  overlays),  SIP.CMD(  PIP. CMD  renamed  by  the  user),  and 
STAT.CMD.  Diskette  #3,  called  the  linker  diskette,  should  contain 
the  MT+  linker (  CMD  file  and  its  overlays)  and  the  SUBMIT.CMD 
file.  For  single  stroke  execution,  it  is  convenient  to  rename  the 
compiler,  editor,  and  linker  respectively  M.CMD,  S.CMD,  and 
L.CMD. 

Tlie  following  is  the  start  up  process.  Put  the  compiler 
diskette  in  drive  A:  and  the  editor  diskette  in  drive  B:  and  then 
turn  the  power  on.  When  the  ’‘A>''  prompt  comes  up,  key  in  "PIP 
M;=B:S*.*".  This  will  transfer  the  editor,  SIP. CMD,  and  STAT.CMD 
to  the  M;  drive.  One  can  use  an  editor  other  than  DRI ' s  Speed 
Editor.  Users  of  UCSD's  P-Editor  will  find  the  Speed  Editor 
acceptable  when  not  in  the  P-system.  After  the  editor  is 
transferred  to  RAM  drive,  one  removes  the  editor  diskette  from 
drive  li:  and  inserts  a  work  diskette  containing  source  and  their 


compiled,  R86,  files. 


One  then  presses  Control-C  and  changes  the  default  drive  to 
M:.  If  one  wants  to  edit  an  existing  source  file,  one  uses 
SIP.CMD  on  drive  M;  to  "pip"  the  source  file  from  drive  B:  to 
drive  M: .  While  in  the  M;  drive,  one  edits  a  Pascal  source  file. 
If  one  is  using  the  Speed  Editor,  a  word  of  caution  is  necessary. 
If  one  attempts  to  save  a  file  on  a  drive  without  enough  memory ( 
including  RAM  drive),  the  old  source  file  as  well  as  the  source 
file  in  the  editor's  buffer  will  be  lost.  This  potentially 


serious 

problem 

can  be  avoided  if  one 

is 

aware 

of 

it 

If 

the 

Speed  Editor  is 

used  one  should  use 

its 

syntax 

scanner 

and 

variable 

checker 

to  locate  syntax  errors 

and 

typos 

prior 

to 

compilation . 

Once  a  source  file  has  been  edited  it  must  be  compiled.  It 
is  not  necessary  to  transfer  the  compiler  to  RAM  drive.  One  must 
change  the  default  drive  from  M:  to  A;,  leaving  the  compiler 
diskette  in  drive  A:  and  the  source  file  on  RAM  drive.  Since 
Pascal  MT+  is  oriented  toward  modularity  and  modular  compilation 
in  particular,  individual  source  files(  modules  and  overlay 
modules  )  are  relatively  short.  Because  of  this,  disk  I/O  to 
drive  A:  to  load  the  compiler  overlays  is  not  too  frequent.  With 
the  source  code  being  read  from  RAM  drive  and  compiled  code  being 
written  to  Ri\M  drive,  compiles  are  quite  timely. 

To  compile  all  the  overlays  and  modules  for  the  linear 
algebra  calculator,  one  must  do  the  following  tasks.  There  are 
eleven  source  codes  which  must  be  saved  on  the  work  disk.  They 


arc  (1)  MATRIX. SRC, 


(2)  CRTLIB.SRC,  (3)  lOMATRIX . SRC ,  (4) 


EICENBAL.SRC,  (5)  EIGENHQR . SRC ,  (6)  MHELP.SRC,  (7)  LLNSYS.SRC, 
(0)  DETERM. SRC,  (9)  AXEQSB.SRC,  (10)  POLYROOT . SRC ,  AND  (11) 
EIGENVEC .  SRC.  Each  file  should  be  transferred  to  Ri\M  drive  and 
then  compiled.  To  compile  the  root  overlay,  MATRIX. SRC,  one 
enters  the  following  command;  "MT+86  M: MATRIX . SRC" .  If  one 
changed  the  name  of  the  compiler  to  M.CMD,  then  one  enters  "M 
M : MATRIX . SRC" .  The  compiler  will  compile  the  file  and  write  a 
code  file,  MATRIX. ROG,  to  RAM  drive.  Similarly,  one  compiles  the 
other  ten  source  code  files  to  produce  ten  more  RBG  code  files. 
These  code  files  should  be  saved  on  the  work  diskette  in  drive 
B;.  It  should  be  emphasized  that  if  the  source  code  of  a  module 
or  overlay  module  is  not  changed,  then  it  does  not  have  to  be 
complied . 

The  most  important  implementation  method  in  MT+  code 
development  is  to  automate  the  linking  process.  Without  this 
automation,  the  linking  process  is  extremely  time  consuming. 
Automatic  linking  is  accomplished  by  using  SUBM1T.CMD  and  linker 
input  command  files,  called  KMD  files.  These  will  now  be 
described  in  detail  and  applied  to  the  linear  algebra  calculator, 
once  all  the  overlays  have  been  compiled  one  makes  up  a  KMD  file 
for  each  compiled  overlay  module.  A  KMD  file  is  actually  a  text 
file  keyed  in  using  an  editor  and  given  the  suffix  KMD  instead  of 
the  usual  SRC  suffix.  The  following  KMD  text  files  are  needed; 

(1)  Md.KMD  with  the  line  of  source; 


M  ;  MATRIX,  M;CRTLIB,  M:TRAWCENL',M;87REALS,  M:  PASLIB/S/E/W 


(2)  Ml.KMD  with  the  line  of  source: 


M;MATRIX.O01=M:MATRIX/O: 1 ,M:LINSYS,M; PASLIB/S/P: 8600/L 
(J)  M3.KMD  with  the  line  of  source: 

M :  MATRIX.  003=M :  MATRIX/0:  3,  M:  lOt'lATRIX.M:  PASLlB/S/P:a60U/L 

(4)  M5.KMD  with  the  line  of  source: 

M:MATRIX.005=M:MATRIX/O: 5,M:EIGENHQR,M: PASLIB/S/P:860U/L 

(5)  Mb.KHD  with  the  line  of  source: 

M:MATRIX.006=M;MATRIX/O:6,M:EIGENBAL,M: PASLIB/S/P:86O0/L 

(6)  M23.KMD  witli  the  line  of  source: 

M : MATRIX. 01 7=M: MATRIX/0: 2 3, M:MHELP,M:PASLIB/S/P:D200/L 

(7)  M19.KMD  with  the  line  of  source: 

M:MATRIX.013=M:MATRIX/O: 19, M: DETERM, M:PASLIB/S/P:D200/L 

(8)  M2U.KI^D  with  the  line  of  source; 

M : MATRIX. 01 4=M: MATRIX/0; 20, M ; AXEUSB, M : PASLIB/S/P;D2O0/L 

(9)  M21.KMD  with  the  line  of  source; 

M: MATRIX. 015=M;MATKIX/O; 21 ,M; POLYROOT,M: PASLIB/S/P;  D200/L 

(10)  M24.KMD  with  the  line  of  source: 

M:MATRlX.0l8=M:MATRIX/O; 24,M:EIGENVEC,M; PASLI B/S/P ; D200/L 
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(11)  MR.KMD  with  two  lines  of  source: 

M : MATRIX, M;CRTLIB,M:TRANCEND,M: 87REALS, /C 

M;PASLIB/S/D:8000/Vl:8G00/V2:D2k3O/R:FCUO/Z:  300 

These  linker  input  command  files  are  stored  on  the  linker 
diskette.  As  with  the  editor,  RAM  drive  will  be  used  extensively. 
One  transfers  the  compiled,  R86,  files  from  the  work  diskette  to 
the  M:  drive.  Then  one  transfers  the  three  R86  library  files  to 
the  M:  drive:  (1)  87REALS.R86,  (2)  PASLIB.R86,  and  (3) 

TRANCEND. K86 .  If  one  does  not  use  the  8087  chip  then  FPREALS.R86 
must  be  used  in  place  of  87REALS.R86.  At  this  point,  one  should 
remove  the  compiler  diskette,  and  insert  the  linker  diskette. 
Then  one  enters  Control-C  and  makes  A:  the  default  drive.  The 
input  command  files  save  a  lot  of  time  since  the  overlay  module 
names  and  addresses  rarely  change  during  program  development. 
Remember  that  the  linker  has  been  renamed  L.CMD  for  keyboard 
simplicity.  Instead  of  keying  in:  "L  M;MATRIX,M:CRTLIB,  M: 
TRAUC£ND,M:87REALS,M;PASLIB/S/E/W"  one  simply  enters:  "L  M0/F" . 
Without  the  input  command  files  option,  one  would  have  to  do 
eleven  links,  keying  in  by  hand  each  time  all  of  the  names  and 
addresses  in  the  linker  input  command  files.  Instead,  one  merely 
executes  the  eleven  commands:  (1)"L  M0/F",  (2)"L  Ml/F",  (3)"L 

M3/F",  (4)  "L  M5/F",  (5)  "L  Mo/F",  (6)  "L  M23/F",  (7)  "L  M19/F", 

(8)  "L  M20/F"  ,  (9)  "L  M21/F",  (10)  "L  M24/F",  (11)  "L  MK/F" . 

One  can  further  automate  the  above  process  by  using 
SUBMIT. CMU  to  do  batch  processing  of  the  above  eleven  commands. 


To  do  this,  one  must  prepare  a  textfiie,  with  the  suffix,  SUB.  In 
the  linear  algebra  calculator,  this  SUB  file  is  called 
ML1NK2.SUB.  In  this  text  file,  each  line  of  text  will  be  a  single 
command.  The  eleven  command  lines  of  this  textfiie  will  be  the 
command  lines  of  the  above  paragraph.  It  should  be  noted  that 
this  SUUMIT.CMD  code  is  a  very  sensitive  code.  lihen  the 
ML1NK2.SUB  was  constructed  using  the  Speed  Editor,  the  batch 
process  would  not  execute.  If  MLINK2.SUB  was  constructed  using 
WORDSTAR  with  no  editing  changes,  it  worked  fine.  Also,  some 
editing  such  as  exclianges  gave  no  problem  while  deletes  did. 
SUBMIT. CMD  seems  to  perform  better  under  CCPM-86. 

Tlie  following  is  the  file  configuration  to  do  an  automatic 
link.  All  RB6  files  including  compiled  source  files  and  run-time 
libraries  must  be  on  drive  M:.  The  linker  diskette,  in  drive 
A:, must  contain  L.CMD  and  its  overlays,  SUBMIT.CMD,  ML1NK2.SUB, 
and  the  eleven  linker  input  command  files. 

With  A:  as  the  default  drive,  one  enters  "SUBMIT  MLINK2"  and 
the  linking  process  will  be  automatically  executed.  Once 
automated,  the  linking  process  is  not  a  big  hassle.  Linking  MT+ 
code  is  the  price  one  pays  for  modular  compilation.  The  link  will 
be  fairly  fast,  considering  the  size  of  tlie  codes.  The  fact  that 
ttie  RBG  files  are  being  read  from  RAM  drive  and  the  final 
overlays  are  being  written  to  RAM  drive  creates  a  tremendous 
savings  in  time.  The  linker  will  create  ten  overlays:  (1) 
MATRIX. CMU,  (2)  MATRIX. UUl,  (3)  MATRIX .  lc)U3 ,  (4)  MATRIX. UU5,  (5) 
MATRIX. 0J6,  (6)  MATRIX. k)17,  (7)  MATRIX. Idl3,  (b)  MATRIX. U14,  (9) 
MATRIX. U15,  (10)  MATRIX. 01b.  After  they  have  been  created,  they 


should  be  transferred  to  another  diskette  to  be  saved  and 
executed  as  desired.  It  might  be  possible  to  put  the  linker  and 
its  overlays  and  the  KMD  files  on  RAM  disk  also  if  one  had  a 
larger  RAM  drive.  It  does  not  seem  that  there  is  a  tremendous 
loss  in  time  to  load  the  linker  overlays  and  read  the  command 
files  from  a  diskette.  If  the  R86  files  are  read  from  a  diskette 
and  the  compiled  overlays  are  wriiten  to  a  diskette,  there  is  a 
tremendous  loss  of  time.  One  has  to  keep  in  mind  that  SUBMIT.CMD 
is  sensitive  to  the  selection  of  drives  that  have  the  files  that 
it  is  batch  processing.  It  seems  only  experimentation  tells  what 
SUBMIT.CMD  accepts;  it  went  for  the  above  configuration. 
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SOURCE  LISTINGS 


(*  VERSICiJ  0285  *) 

PROGRAM  MATRIX; 

CONST  MAXDEG  =  20; 

MAXDEGPl  «  21; 

TYPE  DOMRPl  =  1.. MAXDEGPl; 

DOMAINl  =  1..20; 

MATRIX  =  ARRAY [DOMAINl .DOMAINl]  OF  REAL; 

LISTI  =  ARRAYIDOMAINl]  OF  INTEGER; 

LISTR  =  ARRAY [DOMAINl]  OF  REAL; 

LISTRPl  =  ARRAY [DOMRPl]  OF  REAL; 

CRTCOMMAND  =  ( ERASEOS , ERASEOL , UP , DOWN , R IGUT , LEFT , LEAD I N , T IME , 
FCOLOR,BCOLOr.,REVIDON,REVlDOFF,  I  NTENON ,  I NTENOFF 
BLINKON, 

BLINKOFF) ; 

SETOFCUAR  =  SET  OF  CHAR; 

PTR  =  “INTEGER; 

CPMOPERATION  =  (COLDBOOT , WARM300T , CONSTAT , CON I N .CONOUT , LI ST , 

PUNOUT,RDRIH,HOME.SELDGK,SETTRK,SETSEC,SETDMA 
DSKREAD,DSKI;RITE)  ; 

STRIHG40  =  STRING[40]; 

STRINGG  =  STRING[6]; 

STRING80  *  STRING[80]; 


VAR  I ,  J,  lONDIM,  lOM.ROVJDIMB:  INTEGER; 

SELECT:  CHAR; 

OKGET;  SETOFCHAR; 

ACIFLAG, lOBFLAG.QUITFLAG.SYMFLAG:  BOOLEAN; 

IOTA,TA,TVEC:  MATRIX; 
lOTB.TCMPTB.XX:  MATRIX; 

TEV.TEVR.TEVI :  LISTR; 

SBLASTX .SBLASTY:  EXTERNAL  INTEGER; 

T  CM  P I OM , TEMP I ON :  INTEGER; 

GSDET:  REAL; 

(*  EXTERNAL  PROCEDURES  AND  FUNCTIONS  *) 

EXTERNAL  PROCEDURE  CRTINIT; 

EXTERNAL  PROCEDURE  CRT (C :CRTCOMMAND) ; 

EXTERNAL  PROCEDURE  GOTOXY ( X , Y : INTEGER) ; 

EXTERNAL  PROCEDURE  PROMPTAT  ( Y ;  I NTEGER ;  S  :  STR I TJG )  ; 

EXTERNAL  PROCEDURE  CLEARSCREEN; 

EXTERNAL  PROCEDURE  CLEARI T ( I ; I NTECER ) ; 

EXTERNAL  FUNCTION  GETCHAR (OKSET : SETOFCHAR ) :  CHAR; 

EXTERNAL  PROCEDURE  GETSTRING  { VAR  S :  STRI NG ;  MAXEEt: :  INTEGER); 


EXTERNAL  FUNCTION  YES;  BOOLEAN; 


EXTERNAL  PROCEDURE  VJAIT; 

EXTERNAL  PROCEDURE  WHEAD ( S : STRING) ; 

EXTERNAL  PROCEDURE  INTREAD(VAR  K:INTEGER); 

EXTERNAL  FUNCTION  VALUE(VAR  StSTRING;  VAR  PrlNTEGER):  REAL 
EXTERNAL  PROCEDURE  GETREAL{VAR  S : STR I NG ; MAXLEN : I NTEGER) ; 
EXTERNAL  [3]  PROCEDURE  MATRIXIO; 

EXTERNAL  (23]  PROCEDURE  HELP; 

EXTERNAL  [19]  PROCEDURE  TTRDET; 

EXTERNAL  (20]  PROCEDURE  TTSAXB; 

EXTERNAL  (21]  PROCEDURE  TTRPQR; 

EXTERNAL  (24]  PROCEDURE  TTRNAA; 

(*  END  OF  EXTERNAL  DECLARATIONS  *) 

PROCEDURE  PREAXB; 

(*  SAVES  B  VmiLE  THE  INVERSE  OF  A  IS  COMPUTED  *) 

VAR  I,J;  INTEGER; 

BEGIN  (*  PREAXB  *) 

IF  lOBFLAG  THEN 
BEGIN 

TEMPIOM  :=  lOM; 

FOR  l:=l  TO  ROWDIMB  DO 
FOR  J:=l  TO  lOM  DO 

TEMPTB(I,J]  :=  IOTD(I,J]; 

TEMP  I  ON  :=  ROVJDIMD; 

END; 

lOM  :=  lONDIM; 

FOR  I : =1  TO  lONDIM  DO 
FOR  J:=l  TO  lOtiDIM  DO 
IOTn(I,J]  ;=  0.0; 

FOR  I:  =  l  TO  lONDItl  DO 
IOTD[I ,1]  ;=  I.O; 

'!'  I'FAXB ; 

IF  rOBFLAG  THEN 
BEGIN 

lOM  :=  TEMPIOM; 

FOR  l:=l  TO  ROWDIMB  DO 
FOR  J:»l  TO  lOM  DO 

IOTB[I,J]  :=  TEMPTn(I,J]; 

END ; 

END;  (*  PREAXB  *) 


CRTIMIT; 

QUITFLAG  :=  FALSE; 

AO  I  FLAG  :=  FALSE; 
lOnPLAG  :=  FALSE; 

REPEAT 

CLEARSCREEN; 

L'IIEAD( 'LIMEAR  ALGEBRA  CALCULATOR’); 

GOTOXY(0,3)  ; 

'..’RITEL’J  (  •  •:5,'A  '  ,  '  REAL  POLYNOMIAL  ROOT  SOLVER’); 

U'RITELN; 

WRITELM(’  ':5,'n  '.’EIGENVECTORS  OF  REAL  MATRIX’); 

WRITELN; 

■.JRITELN{’  ’:5,’C  ’.’SOLUTION  OF  NONSINGULAR  LINEAR  EQUATIONS’); 
WRITELN; 

WRITELNC  ’:5.’D  ’.'DETERMINANT  OF  REAL  MATRIX'); 

WRITELN; 

\a'ITELN('  ':5.'E  '.'INVERSE  OF  REAL  MATRIX'); 

WRITELN; 

WRITELNC  ':5.'F  '.'EDITItJG  AND  DISPLAY  OF  INPUT  MATRICES'); 
WRITELN; 

WRITELNC  ':5.'G  '.'DIRECTIONS  FOR  USE  OF  CALCULATOR'); 

WRITELN; 

WRITELNC  ':5.’Q  '.'QUIT'); 

WRITELN; 

WRITEC  ':5. 'SELECT  ONE  :  ’); 

IF  AOIFLAG  THEN 
BEGIN 

OKSET  ;=  CA'..’F’)-CC’l; 

IF  lOBFLAG  THEN 
BEGIN 

IF  ROWDIMB=IONDIM  THEN 
OKSET  ;=  OESET+  [’C  ]  ; 

END; 

END 

ELSE 

C!:SET  :=  [  'A'  ,  'F'  ]  ; 

OKSET  :=  OKSET+[ 'G'  , 'Q'  ]  ; 

SELECT  ;=  GETCHAR (OKSET) ; 

CLEARSCREEN; 

IF  SELECT='Q'  THEN 
BEGIN 

PROMPTAT  ( 10 .  '  DO  YOU  'WANT  TO  ERASE  THE  EDITED  MATRICES?  Y/N  ') 
IF  YES  THEN 

QUITFLAG  :=  TRUE; 

CLEARSCREEN; 

END 

ELSE 

CASE  SELECT  OF 
•A':  TTRPQR; 

'E';  TTRNAA; 

•C:  TTSAXC; 

'O’:  TTRDET; 

'E':  PREAXD; 

' F'  :  MATRIX  10; 


(*  VEnSIOM  0289  *) 
MODULE  CRTLIB; 


TYPE  CRTCOMMAND  =  ( ERASEOS , ERASEOL , UP , DOWN , RIGHT , LEFT , LEADI N , TI ME , 

FCOLOR,BCOLOR,REVIDON,REVIDOFF, IHTENON, INTENOFF, 
BLINKON, 

BLINKOFF) ; 

SETOFCHAR  =  SET  OF  CHAR; 

PTR  =  'INTEGER; 

CPMOPERATION  =  (COLDBOOT , WARMBOOT ,CONSTAT , CON I N , CONOUT , LI ST , 

PUNOUT,RDRIH,HOME,SELDSK,SETTFK,SETSEC,SETDMA, 
DSKREAD,DSKWRITE) ; 

COLOR  =  ( BLACK, BLU E, GREEN, CYAN, RED, MAGENTA, BROWN, LGRAY, GRAY, LBLUE, 
LGREEN , LCYAN , LRED , LMAGENTA , YELLOW , KH I TE) ; 

STRING40  =  STRINGI40]; 

CONST  BELL  =  07; 

RTN  =  13; 

BSP  =  8; 

VAR  3BLASTX,SBLASTY:  INTEGER; 

CRTINFO:  ARRAY [CRTCOMMAND]  OF  CHAR; 

CCLORINFO:  ARRAY [COLOR]  OF  INTEGER; 

PREFIXED:  ARRAY [CRTCOMMAND ]  OF  BOOLEAN; 

BDOSVAL;  INTEGER;  (*  GLOBAL  VARIABLE  FOR  BIOS  CALLS  *) 

EXTERNAL  FUNCTION  0BDOS3 6 ( FUNC : INTEGER ;  PARMrPTR):  INTEGER; 


PROCEDURE  BIOSCALL (FUNC:CPMOPERATION;OCH: INTEGER) ; 

VAR  L'ESCRIPT:  ARRAY  [1,.  5]  OF  BYTE; 

TBITE:  BYTE; 

J:  INTEGER; 

BEGIN  (*  BIOSCALL  *) 

IF  FUNC=CONOUT  THEN 
BEGIN 

TRITE  :»  OCH; 

CLRBIT  (TDITr.,8)  ; 

DESCRIPT [1]  :=  4; 

DF,SGkIPT[2]  :=  TBITE; 

DrSCRIPT(3]  :=  '  '; 

DF.SCRI  PT  [  4  ]  :=  '  '; 

Dt.ErRiP';  [5]  :=  '  '; 

E'ESVAL  :=  OBDOSHG ( 5C ,ADnR (DESCRIPT [ I ])) ; 

en:;; 

IF  FL:.'r  =  "0:!  IN  THEN 
'DGIN 

.DECK  I  PT  r  1  ]  :=  3; 

;  E'  .I:=2  TO  5  DO 
DF.SCRIPTIJ]  :=  ' 


I 


/  / 


3D0SVAL  :»  0BDOS86(5O,ADDR{DESCRIPT[1] ) ) 
END; 

END;  (*  BIOSCALL  *) 


PROCEDURE  CRTINIT; 

VAR  OPCRT:  CRTCOMMAND; 

BEGIN  (*  CRTINIT  *) 

CPTINFO [LEADIN]  :=  CHR(27); 
CRTIMFO [ERASEOS]  :=  'J'; 

CRTINFO [ERASEOL]  :=  'K'; 

CRTINFO  [RIGHT]  :=  'C; 

CRTINFO [LEFT]  :=  ’D'; 

CRTINFO[UP]  :=  'A'; 

CRTIIIFO  [DOWN]  :=  'B'; 

CRTINFO [TIME]  :=  ’  '; 

CRTIMFO [FCOLOR]  :=  'b'; 

CRTINFO [BCOLOR]  :=  'c'; 

CRTINFO [REV I DON]  ;=  'p'; 

CRTINFO [REVIDOFF]  ;=  'q'; 

CRTINFO [ INTENON]  ;=  'r'; 

CRTINFO [ I NTENOFF]  :=  'u'; 

CliTINFO  [ULINKON]  :=  's'; 

CRTINFO [BLINKOFF]  :=  't'; 
PREFIXED [LEADIN]  :=  FALSE; 
PREFIXED  [ERASEOS]  :=  TRUE; 
PR’EFIXED  [ERASEOL]  :  «=  TRUE; 
PREFIXED [RIGHT]  :=  TRUE; 

PREFIXED [LEFT]  :=  TEIE; 
PnEFIXED[UP]  :*  TRUE; 

PREFIXED [DOWN]  :=  TRUE; 

PREFIXED [TIME]  :=  FALSE; 

FOR  OPCRT: =FCOLOR  TO  BLINKOFF  DO 
PREFIXED [OPCRT]  :=  TRUE; 

END;  (*  CRTINIT  *) 


PROCEDURE  CRT (C:CRTCOMMAND) ; 

BEGIN  (*  CRT 

IF  PREFIXED [C]  THEN 

BIOSCALL (CONOUT,ORD (CRT  I NFO [ LEADI N ] ) )  ; 
BICSCALL(CONOUT,ORD(CRTINFO[C] ) ) ; 

END;  (*  CRT  *) 


PROCEDURE  GOTOXY (X,Y: INTEGER)  ; 
VAR  I:  INTEGER; 

BEGIN  (*  GOTOXY  *) 

FOR  I:=l  TO  100  DO; 

CRT (LEADIN) ; 

FOR  l:=l  TO  100  DO; 

BIOSCALL (CONOUT,ORD ( ' Y' ) ) ; 
FOR  l:=l  TO  100  DO; 

BIOSCALL (CONOUT,Y+ 32) ; 

FOR  I:=l  TO  100  DO; 


BIOSCALL (CONOUT,X+32)  ; 
SBLASTX  ;=  X; 

SBLAETY  :=  Y; 

FOR  l:=l  TO  100  DO; 
END;  (*  GOTOXY  *) 


PROCEDURE  PROMPTAT (Y: I NTEGER ; S : STR I NG) ; 

VAR  J:  INTEGER; 

BEGIN  (*  PROMPTAT  *) 

GOTOXY (0 ,Y) ; 

..'KITE(G)  ; 

CRT (ERASEOL) ; 

FOR  J:=l  TO  4  DO 
CRT (TIME) ; 

END;  (*  PROMPTAT  *) 

PROCEDURE  CLEARSCREEM; 

VAR  J:  INTEGER; 

BEGIN  (*  CLEARSCREEM  *) 

GOTOXY  (0 , 0)  ; 

CRT (ERASEOG)  ; 

FOR  J;=l  TO  4  DO 
CRT  (TIME)  ; 

END;  (*  CLEARSCREEM  *) 

PROCEDURE  CLEARITd  ;  INTEGER)  ; 

VAR  J;  INTEGER; 

BEGIN  (*  CLEARIT  *) 

GOTOXY (0,1) ; 

CRT (EPASEOS) ; 

FOR  J:=l  TO  4  DO 
CRT  (TIME)  ; 

END;  (*  CLEARIT  *) 

FUNCTION  GETCHAR  (OKSET:SETOFCIIAR)  ;  CHAR; 

VAR  CH:  CHAR; 

OCH:  INTEGER; 

GOOD;  BOOLEAN; 

BEGirJ  (*  GETCHAR  *) 

REPiiAT 

UlOSCALL(CONIH,0) ;  (*  0  IS  A  DUMMY  VARIABLE  *) 

ClI  :=  CHR  (BDOSVAL)  ; 

OCl!  :=  ORD(CH); 

IF  OCH>96  THEN 
IF  OCH<123  THEN 

C!1  :=  CflR(OCH-32)  ; 

GOOD  :=  CH  IN  OKSET; 

IF  NOT  GOOD  THEN 
k'RITE  (CHR  (7)  ) 

ELSE 

IF  CH  IN  [ •  THEN 

VIRITE  (CH)  ; 

UNTIL  GOOD; 

GirClirR  :=  CH; 


END;  (*  GETCHAR  *) 


PROCEDURE  GETSTRING (VAR  S:  STRING;  MAXLEN:  INTEGER); 
VAR  SI :  STRING  [1]  ; 

STEMP:  STRING; 

GKSET:  SET  OF  CHAR; 

BEGIN  (*  GETSTRING  *) 

OKSCT  :=  [  ' 

S 1  :  =  ’  '  ; 

STEMP  := 

REPEAT 

IF  LENGTH (STEMP)  =  0  THEN 
Sl[l]  :=  GETCHAR (OKSET  ) 

EI.SE 

IF  LENGTH (STEMP) =MAXLEN  THEM 

Sl[l]  :=  GETCHAR ( (CHR (RTN) ,CHR ( 

BSP) ] ) 

ELSE 

SI [11  :=  GETCHAR (OKSET  +  [CHR (RTN) ,CHR (BSP) ] ) ; 

I F  Sl|  1]  IN  OKSET  THEN 

STEMP  ;=  CONCAT (STEMP, SL) 

ELSE 

IF  SI [1] =CHR(BSP)  THEN 
BEGIN 

CRT (LEFT) ; 

WRITE ( '  ' ) ; 

CRT (LEFT) ; 

DELETE (STEMP, LENGTH (STEMP) ,1) ; 

END; 

UNTIL  SI  [1]  =  CHR (RTN)  ; 

IF  LENGTH (STEMP)  <>  0  THEN 
S  :=  STEMP 
ELSE 

;.’niTE(S) ; 

END;  (*  GETSTRING  *) 

FUNCTION  YES:  BOOLEAN; 

BEGIN  (*  YES  *) 

YES  :=  GETCHAR( [ 'Y' , 'N' ] )  IN  [’Y’l; 

END;  YES  *) 


PROCEDURE  WAIT; 

BEGIN  (*  WAIT  *) 

CLEAR  IT (5)  ; 

PPOMPTAT ( 10 , ' PLEASE  WAIT. .  .  '  )  ; 
END;  (*  WAIT  *) 

PROCEDURE  WHEAD (A: STRING)  ; 

VAR  I:  INTEGER; 

BEGIN  (*  WHEAD  *) 

CLEARSCREEN; 

I  : =  (80-LENGTH (A) )  DIV  2; 
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WRIVELN (A)  ; 

GOTC'XY  (1,1); 

FOR  I:=l  70  LENGTH (A)  DO 
IF  A[I]='  '  THEN 

URITEC  ’) 

ELSE 

WRITE ( ' - ’ ) ; 
v;riteln; 

END;  (*W11EAD*) 

PROCEDURE  INTREAD(VAR  K:INTEGER); 

TYPE  S'l'RINGG  =  STRING[6]; 

VAR  S:  GTRItIG6; 

PROCEDURE  GETISTRING (VAR  3 : STR I NG6 ; MAXLEN : I NTEGER) 
VAR  31 :  STRING [1] ; 

STEMP,TTEMP:  STRING6; 

OKSET,OKAYSET:  SET  OF  CHAR; 

FLAGl ,FLAG2 ,NFLAG:  DOCLEAN; 

I ,L,MAX,T1,T2,T3,T4 ,TS:  INTEGER; 

PROCEDURE  CHECKINT; 

VAR  I:  INTEGER; 
nEaiN(*  CHECKINT  *) 


TTEMP  := 

STEMP; 

IF  FLAG2 

THEN 

DELETE(TTEMP,1,1)  ; 

IF  LENGTH (TTEMP) <5  THEN 

FLAGl 

:=  FALSE 

ELSE 

BEGIN 

T1  : 

-  ORD (TTEMP [1] )  ; 

T2  : 

=  ORD (TTEMP [2] ) ; 

T3  : 

=  ORD(TTEMP [3] ) ; 

T4  : 

=  ORD (TTEMP [4]  )  ; 

T5  : 

=  ORD (TTEMP [5] ) ; 

IF  Tl<=51  THEN 
IF  Tl=51  THEN 
IF  T2<=50  THEN 
IF  T2=50  THEN 
IF  T3<=55  THEN 
IF  T3=55  THEN 
IF  T4<=54  THEN 
IF  T4=54  THEN 
BEGIN 

IF  NFLAG  THEN 
BEGIN 

IF  T5<=56  THEN 
FLAGl  :=  FALSE 
ELSE 

FLAGl  :=  TRUE 

END 

ELSE 

BEGIN 


IF  T5<=55  THEN 
FLAGl  :=  FALSE 
ELSE 

FLAGl  :=  TRUE 

END 

END 


ELSE 


FLAGl 

:  = 

FALSE 

ELSE 

FLAGl 

•  = 

TRUE 

ELSE 

FLAGl 

FALSE 

ELSE 

FLAGl 

•  . 

TRUE 

ELSE 

FLAGl 

•  s 

FALSE 

ELSE 

FLAGl 

•  . 

TRUE 

ELSE 

FLAGl 

•  s 

FALSE 

ELSE 

FLAGl 

•  ~ 

TRUE; 

END; 

IF  FLAG1=TRUE  THEM 
BEGIN 

FLAGl  :=  TRUE; 

L  :=  LENGTH (STEMP) ; 

FOR  l;=l  TO  L  DC 
Cr.T  (LEFT)  ; 

FOR  l;=l  TO  L  DO 
WRITE ( '  ' ) ; 

FOR  l:*l  TO  L  DO 
CRT (LEFT) ; 

FOR  l;=l  TO  L  DO 
WRITE (CHR (BELL) ) ; 

END; 

END; {*  CHECKINT  *) 

EEGIN{*  GETISTRING  *) 

KE.PEAT 

GKSET  :=  0’ . . ' 9’ ]  I 

SI  :=  '  '  ; 

STEMP  := 

NFLAG  :=  FALSE; 

IM’PEAT 

IF  LENGTH (STEMP)  =  0  THEN 
BEGIN 

MAX  :=  MAXLEN-1; 

FLAG2  ;=  FALSE; 

0KAY3ET  :=  OKSET+ 1  ; 
Sl[l]  ;=  GETCHAR (OKAYSET) ; 

IF  SI  [1]  IN  (('  +  ',''■'))  them 
BEGIN 

IF  SI [1]='-'  THEN 
NFLAG  :=  FALSE; 


MAX  :=  MAX+1; 

FLAG2  :=  TRUE; 

END; 

END 

ELSE 

IF  LENGTH (STEMP) =MAX  THEN 

Sl[l]  :=  GETCHAR  (  [CHR (RTN)  ,CHR 
(BSP) ] ) 

ELSE 

BEGIN 

IF  (LENGTH (STEMP) =1)  AND  FLAG2 
THEN 

Sl[l]  :=  GETCHAR (OKSET+ [CHR (BSP) 1 ) 
ELSE 

Sl[l]  :=  GETCHAR (OKSET  +  (CHR(RTN), 

END; 

IF  Sl[l]  IN  (OKSET+ ['+','-•] )  then 
STEMP  :=  CONCAT (STEMP, SI 
) 

ELSE 

IF  SI [1] =CHR (DSP)  THEN 
BEGIN 

CRT (LEFT) ; 

WRITE ( '  ' ) ; 

CRT (LEFT) ; 

DELETE (STEMP, LENGTH (STEMP)  ,1)  ; 

END; 

UNTIL  SI [1]  =  CHR(RTN) ; 

CHECKINT; 

UNTIL  NOT  FLAGl; 

S  :=  STEMP; 

END;(*  GET  I  STRING  *) 

PEOCEDURE  STRTOINT(VAR  S : STR I NG6 ; VAR  K; INTEGER) 
CONST  z  =  ^8; 

V;,R  STE'IP:  STRINGS; 

FLAGP:  BOOLEAN; 

I,L:  INTEGER; 

BEGIN  (*  STRTOINT  *) 

SIF.'lP  :=  S; 

IF  STEMP[li='-'  THEN 
ELAGP  :=  FALSE 
ELSE 

FLAGP  :=  TRUE; 

IF  (NOT  FLAGP)  OR  ( STEMP [ 1 ]=’+' )  THEN 
DELETE(STEMP,1,1) ; 

L  :=  LENGTH (STEMP)  ; 

K  :=  0; 

FOR  I:=l  TO  L  DO 

K  :=  10*K  +  ORD (STEMP [ I ]  ) -Z  ; 

IF  FLAGP=FALSE  THEN 
K  :  =  -  K  ; 

end; (*  STRTOINT  *) 


BEGIN (*  INTREAD  *) 
GETISTRING(S,6)  ; 
STRTOIUT (E,K)  ; 
END; (*  INTREAD  *) 


FUNCTION  VALUE(VAR  StSTRING;  VAR  P:INTEGER) 
CONST 

LIMIT  =  l.OE+16; 

Z  =  48;  (*  ORD(O)  *) 

VAR  A,Y:  REAL; 

E,I,J,P2;  INTEGER; 

NEG,NEGEXP,GTL:  BOOLEAN; 

DIGITS:  SET  OF  CHAR; 

FUN'CTION  POWRTEN  (EX  :  INTEGER)  :  REAL; 

VAR  I:  INTEGER; 

T:  REAL; 

BEGIN  (*  POWRTEN  *) 

1  :  =  0 ; 

T  :=  1.0; 

REPEAT 

IF  ODD (EX)  THEN 
CAGE  I  OF 

0:  T  :=  T*1.0El; 

1:  T  :=  T*1.CE2; 

2:  T  :=  T*1.0E4; 

3:  T  :=  T*1.0E8; 

4;  T  :=  T*l.nE16; 

5;  T  :=  T*1.0E32; 

6:  T  :=  T*'1.0E64; 

7:  T  :=  T*1.0E128; 

8:  T  ;=  T*1.0C25G; 

END  ; 

EX  :=  EX  DIV  2; 

I  :  =  I  + 1  ; 

UNTIL  EX=0; 

POWRTEN  :=  T; 

Et;D;  (*  POWRTEN  *) 

BEGIN  (*  VALUE  *) 

I  :=  1; 

P  :  =  0  ; 

P2  :=  0; 

GTL  :=  FALSE; 

DIGITS  :=  [ 'O' . . '9' ] ; 

S  :=  CONCAT (S, ' % ' ) ; (*SAFETY  CHARACTER  *) 

A  :=  0; 

E  :  =  0  ; 

NEC  :=  (S[I]  =  '-')  ; 

WHILE  S[I]='  '  DO 

I  :=  t+l; 

IF  (S[I1='+')  OK  NEG  THEN 


WHILE  S[I]  IH  DIGITS  DO 
BEGIN 

IF  S[I]='0'  THEN 
P2  :=  P2+1 
ELSE 
BEGIN 

P  :=  P+P2+1; 

P2  :=  0; 

GTL  :=  TRUE; 

END; 

IF  A<LIMIT  THEN 

A  :=  10*A+ORD(S[I] )-Z 
ELSE 

E  :=  r.  +  l; 

I  :  =  I  + 1  ; 

END; 

IF  G [ I ] = ' . '  THEN 
BEGIN 

P  :=  P+P2; 

I  :=  I+l; 

IF  NOT  (G[I)  IN  DIGITS)  THEN 
BEGIN 

IMSERTCO'  ,S,I)  ; 

I  :=  I+l; 

END; 

END; 

P2  :=  0; 

'WHILE  G(I]  =  '0'  DO 
BEGIN 

P2  :=  P2+1; 

IF  A<LIHIT  THEN 
BEGIN 

A  :=  10*A+ORD(S[I] )-Z; 

E  :=  E-1; 

END; 

I  : =  I  +  l ; 

END; 

IF  GTL  THEN 
P  :=  P+P2; 

WHILE  G(I]  IN  DIGITS  DO 
BEGIN 

P  :=  P+1; 

IF  A<LIMIT  THEN 
BEGIN 

A  :=  10*A+ORD (S [ I ] ) -Z; 

E  :=  E-1; 

END; 

I  :=  I+l; 

END; 

IF  G [ I ]  IN  [ 'E' , ' E' ]  THEN 
BEGIN 

I  :  =  I  + 1  ; 

J  :  =  0  ; 

NEGEXP  :»  (S [ I ]  =  ; 

IF  (G[I1=’+')  OR  NEGEXP  THEN 


I  :=  l+l; 

WHILE  S[I]  IN  DIGITS  DO 
BEGIN 

IF  J<LIMIT  THEN 

J  :=  10*J  +  OED (S  [  1 1 ) -Z; 

I  ;=  I+l; 

END; 

IF  IJEGEXP  THEN 
E  :=  E-J 
ELSE 

E  :=  E+J; 

END; 

Y  :  =  A ; 

IF  NEG  THEN 
Y  :=  -Y; 

IF  F.<0  THEN 

VALUE  :=  Y/POWRTEN (-E) 

ELSE 

IF  EOO  THEN 
VALUE  := 

Y*POWRTEN (E) 

ELSE 

VALUE  :=  Y; 

IF  ((NOT  MEG)  AND  (Y=0.0))  THEN 
VALUE  :=  -Y; 

WHILE  S[I]='  '  DC 

I  :=  I+l; 

C  :=  COPY (S, I ,LENGTH (S) -I ) ; 

END;  (*  VALUE  *) 

PROCEDURE  GETREAL(VAR  5 : STR I NG ; MAXLEN : INTEGER ) ; 

VAR  SI, 32:  STRING[1] ; 

STEMP:  STRING [80]; 

If!TSET,ALPSET,SIGSET,OKSET,MISCSET:  SET  OF  CHAR; 
LOG:  INTEGER; 

EAR, CHOICE, NTOER:  INTEGER; 

PEKFLAG, EXPFLAG:  BOOLEAN; 

BEGIN  (*  GETREAL  *) 

ALPSCT  :=  ['A'..'Z']; 

INTSET  :=  ['O'. .'9']; 

SIGSET  :=  ['+','-']; 

MI3CSET  :=  ['E','.']; 

EXrFLAG  :=  FALSE; 

S’iEMP  :=  ''; 

SI  :=  '  ' ; 

('  't  .  —  I  I  • 

WJ  •  —  f 

PERFLAG  :=  FALSE; 

V.r.R  :=  0; 

REPEAT 

LCC  :=  LENGTH (STEMP) ; 

IF  LENGTH (STEMP) =0  THEN 
BEGIN 

CK3ET  :=  MISCSET+ INTSET+SIGSET; 

Sl[l]  :=  GETCHAR (OKSET+ [CHR (RTN) ) ) ; 

END 
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ELSE 

IF  LEtlGTH  (STEMP)  =MAXLEM  THEN 
BEGIM 

OKSET  : =  (CHR (RTN) ] ; 

Sl[l]  :=  GETCHAR  (OKSET+ [CllR  (BSP)  ]  )  ; 

EMD 

ELSE 

BEGin 

IF  NOT  EXPFLAG  THEN 
BEGIN 

LOG  :=  LENGTH (STEMP) ; 

S2[l]  :=  STEMP [LOCI; 

IF  S2[l]  IM  SIGSET  THEN 
CHOICE  :=  1 
ELSE 

IF  S2 [1]  IN  INTSET  THEN 
CHOICE  :=  2 

ELSE 

IF  S2 [ 1] = ' . '  THEN 
CHOICE  ;=  3; 

CASE  CHOICE  OF 

1:  OKSET  :=  MISCSET+INTSET; 

2:  OKSET  :=  MISCGET+INTSET+ (CHR (RTN)  ] 

3;  OKSET  :=  M1SCSET4INTSET+[CMR(RTN) ] 

END; 

END 

ELSE 

BEGIN 

LOC  :=  LENGTH (STEMP) ; 

S2 [1]  ;=  STEMP [LOC] ; 

IF  S2[l]  IN  SIGSET  THEN 
CHOICE  :=  1 
ELSE 

IF  S2[l]  IN  INTSET  THEN 
CHOICE  :=  2 

ELSE 

IF  S2[1]=’E'  THEN 
CHOICE  :=  3; 

CASE  CHOICE  OF 

1:  OKSET  :=  INTSET; 

2;  OKSET  :=  INTSET+ [CHR(RTN) ] ; 

3:  OKSET  :=  SIGSET+INTSET; 

END; 

END; 

Sl[l]  ;»  GETCHAR(OKSET+[CHR(BSP)  ]  )  ; 

END; 

IF  Sl[l]  IN  (OKSET- [CIIR  (RTN)  1  )  THEN 
BEGIN 

STEMP  :«  CONCAT (STEMP, SI)  ; 

IF  S1[1]*'E'  THEN 
BEGIN 

EXPFLAG  ;=  TRUE; 

MISCSET  :=  MISCSET- [ ' E ' ] I 
END 
ELSE 


t  I 


THEN 


BEGIN 

PERFLAG  :=  TRUE; 

MISCCET  :=  Ml GCSET- t  '  .  ' ]  ; 

END; 

END 

ELSE 

IF  S1[1]=CHR(BSP)  THEN 
BEGIN 

LOG  :=  LENGTH (STEMP) ; 

IF  STEMP [LOG] = ' . '  THEN 
PERFLAG  :=  FALSE 
ELSE 

IF  STEMP [LOG] =' E*  THEN 
EXPFLAG  :=  FALSE; 

GRT (LEFT) ; 

WRITEC  '); 

CRT (LEFT) ; 

DELETE (STEMP, LOG, 1 )  ; 

END; 

IF  NOT  EXPFLAG  THEN 

MISCSET  :=  MISCSET+ [ ' E' ] ; 

IF  r!OT  PERFLAG  THEN 

MISCSET  :=  MISCSET+ [ '  .  ' 1  ; 

UNTIL  SI [1] =CHR (RTN)  ; 

IF  LENGTH (STEMP) <>0  THEN 
BEGIN 

G  ;=  STEMP; 

r/rOER  :=  23-LENGTH  (S)  ; 

IF  NTOER>0  THEN 
WRITE ('  ':NTOER); 

END; 

END;  (*  GETREAL  *) 

PROCEDURE  SPACEBAR; 

VAR  CM:  CHAR; 

BEGIN  (*  SPACEBAR  *) 

WRITELN; 

WRITE ('PRESS  SPACEBAR  '); 

CH  ; =  GETCHAR ( [ '  ']); 

WRITELN; 

END;  (*  SPACEBAR  *) 

(*  THE  FOLLOWING  ROUTINES  ARE  FOR  COLOR  MONITORS  *) 


(*  PROCEDURE  INITCOLOR; 

VAl:  SHADE;  COLOR; 

I  :  INTEGER; 

BEGIN 
I  :=0; 

FOR  SHADE: “BLACK  TO  WHITE  DO 
BEGIN 

CCLORINFO [SHADE]  :  =  I; 
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I  ;  =  I  +  1; 

e:^d; 

LvD;  *) 

(*  PROCEDURE  ALTCOLOR(C:COLOR) ; 

VAR  J  :  ItlTEGER; 

BRCIU 

CRT (DCOLOR) ; 

FOR  J:=l  TO  100  DO; 

BIOSCALL (CONOUT,COLORINFO [C] ) ; 

FOR  J:=l  TO  100  DO; 

END;  *) 

(*  PROCEDURE  PAINT(X, Y,VnDTU, DEPTH:  INTEGDR;SI1ADE:C0E0R)  ; 
VAR  J: INTEGER; 

BEGIN 

GOTOXY (X,Y) ; 

ALTCOLOR (SHADE) ; 

FOR  J: =1  TO  DEPTH  DO 
BEGIN 

WRITE ('  ':WIDTH); 

GOTOXY (X,Y+J) ; 

END; 

FOR  J;=l  TO  100  DO; 

END;  *) 


MODEND 


■.»  \\  PJI  -J  rj  ^»  V  ’J  '•  J  Wiyjr-'l- 


(*  VERSION  0286  *) 

MODULI:;  OVERLAYl; 

{*  MODULE  LINSYS  *) 

TYPE  DOMAINl  =  1..20; 

MATRIX  =  ARRAY [DOMAINl ,DOMAINll  OF  REAL; 

LI  ST  I  =  ARRAY [DOMAINl 1  OF  INTEGER; 

LISTR  =  ARRAY [DOMAINl ]  OF  REAL; 

EXTERNAL  PROCEDURE  SPACEBAR; 

PROCEDURE  RLUD {ND,N: INTEGER;VAR  KER : I NTEGER ; VAR  ALU : MATR I X ; VAR  JN: 
LISTI;VAR  SCALE : LI STR) ; 

VAR  I, IMD,IP1,IS,J,K,NN:  INTEGER; 

BIG, EL, PIVOT, ROWNRM,T:  REAL; 

CU:  CHAR; 


FUNCTION  AMAXl (A,B: REAL) :  REAL; 

BEGIN  {*  AMAXl  *) 

IF  A<B  THEN 
AMAXl  :=  B 
ELSE 

AMAXl  :=  A; 

END;  (*  AMAXl  *) 

BEGIN  (*  RLUD  *) 

NN  ;=  N; 

(*  COMPUTE  SCALE[I]=1. 0/INFINITY  NORM  OF  ROW [ I ]  OF  A  *) 

FOR  l:=l  TO  NN  DO 
BEGIN 

ROWNRM  :=  0.0; 

FOR  J:=l  TO  NN  DO 

ROWNRM  :=  AMAXl (ROWNRM,ABS(ALU [I , J]  )  )  ; 

IF  ROWNRM=0.0  THEN 
ROWNRM  ;*  1.0; 

SCALE  [I]  :=  l.O/ROV'JNRM; 

END; 

(*  LU  DECOMPOSITION  3Y  GAUSSIAN  ELIMINATION.  L  HAS  UNIT  DIAGONAL.  *) 
(*  EXPLICIT  ROW  INTERCHANGE  WITH  IMPLICIT  EQUILIBRATION  IS  USED  *) 

IS  : =  1  ; 

FOR  T:=l  TO  NN  DO 
B  EG  IN 
WRITE 
IND  ;=  I; 

IF  lONN  THEN 
BEGIN 

BIG  0.0; 

FOR  K;=I  TO  NN  DO 
BEGIN 

T  :=  SCALE[K1 *ADS(ALU[K,I] ) ; 

IF  T>niG  THEN 
BEGIN 

IND  :=  K; 
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BIG  :=  T; 

END; 

END; 

IF  BIGOO.O  THEN 
BEGIN 

IF  INDOI  THEN 
BEGIN 

FOR  J:=I  TO  NN  DO 
BEGIN 

T  ;=  ALU ( IND, J]  ; 

ALU(IND,J]  :=  ALU[I,J]  ; 

ALU [ I , J)  :=  T; 

END; 

SCALE! I ND]  :=  SCALE  1 1 ] ; 

IS  :=  -IS; 

END; 

I  PI  :=  I  +  l; 

PIVOT  :=  ALU  [1 , 1  ]  ; 

FOR  K:=IP1  TO  NN  DO 
BEGIN 

EL  :=  -ALU [K, 1 1/PIVOT; 

ALU[K,I]  :=  -EL; 

IF  ELOO.O  THEN 

FOR  J:=IP1  TO  NN  DO 

ALU(K,J]  :=  ALUIK,J]+EL*ALU(I,J1  ; 

END; 

END; 

END; 

IF  ALU (1, 1 1*0.0  THEN 
IS  :=  0; 

JN[I1  :=  IND; 

E!ID; 

jr.'fNN]  :=  IS; 

KER  :=  0; 

END;  (*  RLUD  *) 

PROCEDURE  RFUS (ND,N: INTEGER;VAR  KER : INTEGER ; VAR  ALU : MATRIX ; VAR  JN 
LISTI ;VAR  X;LISTR) ; 

VAR  I ,K,KP1,L,LP1,NM1,NN;  INTEGER; 

Z:  REAL; 

CIl:  CHAR; 

BEGI!J  (*  RFBS  *) 

NN  : =  N ; 

IF  JN(NN1=0  THEN 
BEGIN 

KER  :=  3; 

VJRITELN; 

V;RITELN  (  '  IN  RFBS,  THE  TRIANGULAR  FACTOR  U  OF  A  '); 

WRITELNC  IS  SINGULAR.  A  UNIQUE  SOLUTION  DOES  '); 

V.RITELNC  NOT  EXIST.'); 

SPACEBAR; 

EXIT; 

END; 

KER  :=  0; 
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IF  MMIOO  THEN 
DEGItl 

(*  GCLVE  LY=3  (FORWARD  SUBSTITUTION)  *) 
FOR  L:=l  TO  NMl  DC 
BEGIN 

WRITEC 
K  :=  JN(L] ; 

Z  :  =  X  I K  ]  ; 

X[K]  ;=  X[L]  ; 

X [L]  :=  Z; 

LPl  :=  L+1; 

FOR  K:»LP1  TO  NN  DO 

X(K]  ;=  X  [Kl-ALU [K,L1 *Z; 

END; 

(*  SOLVE  UX=Y  (BACKWARD  SUBSTITUTION)  * 
FOR  I:=l  TO  NMl  DO 
BEGIN 

WRITE! ' ...'); 

K  :=  NN-I; 

KPl  :=  K+1; 

X[KP1]  :=  X[KP1]/ALU[KP1,KP1] 
Z  :=  -X [KPl] ; 

FOR  L:=l  TO  K  DO 

X(L1  :=  X [L] +ALU [L,KP1] *Z; 

END; 

END; 

X[l]  :=  X(1]/ALU[1,1]  ; 

'ND;  (*  RFB3  *) 


lODEN’D- 


(*  VEKSION  0285  *) 

MODULE  OVERLAY3; 

COtJET  MAXDEG  =  20; 

MAXDEGP1=21 ; 

TYPE  DOMAINl  =  1..20; 

DOMRPl=l. .MAXDEGPl; 

LISTRPl=ARRAY[DOMRPl]  OF  REAL; 

MATRIX  =  ARRAY [DOMAINl,DOMAINl]  OF  REAL; 

LIGTI  =  ARRAY [DOMAIHl]  OF  INTEGER; 

LIGTR  =  ARRAY (DOMAINl]  OF  REAL; 

CRTCOMMAND  =  ( ERASEOS , CRAEEOL , UP , DOWN , R I GHT , LEFT , LEADI N , T IME , 
FCOLOR , DCOLOR , REVIDON , REVl DOFF , I NTENON , I NTENOFF 
BLItJKON, 

BLINKOFF) ; 

SETOFCHAR  =  SET  OF  CHAR; 

PTR  =  “INTEGER; 

CPMOPERATION  =  (COLDBOOT ,  WARMBOOT  ,CCNSTAT ,  COrJ  I  N  ,  CONOUT ,  LI  ST , 

PUNOUT,RDRIN,HOME,SELDSK,SETTRK,SETSEC,SETDMA 
DSKKEAD,DSE',JRITE)  ; 

STRING40  =  STRING [40]; 

STMNG6  =  STRING  [6]; 

ETRING80  =  STRING[80]; 


VAR  AOIFLAG, lODFLAG:  EXTERNAL  BOOLEAN; 

lOM, IONOIM,ROWDIMB;  EXTERNAL  INTEGER; 

ICTA,TVEC;  EXTERNAL  MATRIX; 

IOTB,XX:  EXTERNAL  MATRIX; 

TEV,TEVR,TEVI :  EXTERNAL  LISTR; 

GSDET:  EXTERNAL  REAL; 

(*  EXTERNAL  PROCEDURES  AND  FUNCTIONS  *) 

EXTERNAL  PROCEDURE  CKTINIT; 

EXTERNAL  PROCEDURE  CRT (C : CRTCOMMAND) ; 

EXTERNAL  PROCEDURE  GOTOXY (X ,Y: INTEGER) ; 

EXTERNAL  PROCEDURE  PROMPT AT ( Y : I NTEGER ; S ; STR I NG ) ; 

EXTERNAL  PROCEDURE  CLEARSCREEN; 

EXTERNAL  PROCEDURE  CLEARIT ( I : INTEGER) ; 

EXTERNAL  FUNCTION  GETCHAR (OKSET ; SETOFCHAR) :  CHAR; 

r.XTERNAL  PROCEDURE  GETSTR I  NG  ( VAR  S :  STR  I  NG ;  MAX  I.EM  :  INTEGER); 

EXTERNAL  FUNCTION  YES;  BOOLEAN; 

EXTERNAL  PROCEDURE  WAIT: 


EXTERNAL  PROCEDURE  WHEAD; 


EXTERNAL  PROCEDURE  INTREAD(VAR  KrINTEGER); 

EXTERNAL  FUNCTION  VALUE(VAR  EtSTRING;  VAR  PrlNTEGER):  REAL; 
EXTERNAL  PROCEDURE  GETREAL(VAR  S : STR I  MG ; MAXLEN : I NTEGER )  ; 
EXTERNAL  PROCEDURE  SPACEBAR; 


PROCEDURE  GETCOLUMN (NROW, J: INTLGER;VAR  A:MATRIX); 

VAR  II,K,LL,P4:  INTEGER; 

GREEL:  STRING; 

FLAG:  BOOLEAN; 

PROCEDURE  COLDISPLAY; 

VAR  IC:  INTEGER; 

BEGIN  (*  COLDISPLAY  *) 

CLEAR  IT (2)  ; 

GOTCXY (C , 2) ; 

FOR  IC:=1  TO  NROW  DO 
BEGIN 

K  :=  IC+1; 

GOTOXY (0,K) ; 

WRITE( 'A[  ’  ,IC,',',J,']=’); 

GOTOXY (9, K) ; 

WKITE(A[IC,J] ) ; 

END; 

rRC;irTAT(23,  '  IS  this  CORRECT;  Y/N  '); 

END;  (*  COLDISPLAY  *) 

BEGIN  (*  GETCOLUriN  *) 

FLAG  :=  FALSE; 

REPEAT 

CLEAR  IT ( 2)  ; 

COLDISPLAY; 

IF  NOT  YES  THEN 
BEGIN 

PROMPTAT(23,  '  IF  NO  CflANGE  -  PRESS  RETURN  '); 
FOR  LL:=1  TO  NROW  DO 
BEGIN 

K  :=  LL+1 ; 

GOTOXY (9 , K) ; 

IF  A[LL, J] >=0  THEN 
WRITEC  '); 

SP.EIT  := 

GETREAL (GREEL,  21 )  ; 

IP  LENGTH (PREEL) >N  THEN 

A[LL,J]  :=  VALUE ( SREEL, P4 ) ; 

END; 

END 

ELSE 

IT,  AG  :=  TRUE; 
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UNTIL  FLAG; 

FUD;  (*  GETCOLUMN  *) 

PEGCEPURE  GETPOLCOF (NROW: IMTEGER;VAR  LrLISTRPl); 
VAR  1  ,  J  ,  urw’l  ,::P0DIV2  ,  P4  :  integer; 

SM'.r.L:  GTRING; 

FLAG:  BOOLEAN; 

i’R^CF.LURE  CCLDIGPLAY; 

V.MJ  I:  II.’TEGER; 

LLI!!.  (*  CCLDISPLAY  *) 

rU-LARIT  (2)  ; 

GA'ir  XY  (  n  ,  2)  ; 

■.t(/JIV2  :=  NROW  DIV  2; 

L  A  T : = I  TO  NROn I V2  DO 
■'LL  I  N 

'  (  XY(0,2*I)  ; 

.1  ITA  (  '  COl.F  CF  X  '  )  ; 

’i  :  :'’F)  ; 

A  1  I  t;  (  NFOW-  I  )  ; 


.  X'M12,2M); 

.  F  'Ll  I  1  )  ; 

•  .  f 

■  :  :  =‘;i'  ni V2+ 1  to  nlow  do 

r  i  »  »  «  • 

•  >.  j  t  i  I 

A,,::  :=  I-NRCDIV2; 

..•/'TOXY  (4n,2*NE..’I)  ; 

r;'!:  (  'cclf  of  x'  )  ; 

'•■I  T  (UF)  ; 

..■:'iTi;(r:ROW-i)  ; 

'^FT  (DCWN)  ; 

..'i'  r  TE  ('  =  '); 

GtTCXY (52,2*NEWI) ; 

WRITE (L  [  I  ] )  ; 

END; 

n  ,':1PTAT(23,  ’  IE  THIS  CORRECT?  Y/N  '); 

END;  (*  COLD  I  SPLAY  *) 

BEGIN  (*  GETPOLCOF  *) 

FLAG  :=  FALSE; 

I;ErEAT 

CLEARIT  (2)  ; 

COLD  I  SPLAY; 

IF  NOT  YES  THEN 
BEGIN 

PRCMPTAT (23 , ' IF  NO  CHANGE  -  PRESS  RETURN  ') 
FOR  I:=l  TO  NRODIV2  DO 
BEGIN 

GGTOXY(12,2*I) ; 

IF  Lll)>=0  THEN 
WKITEC  '); 

SR EEL  := 

GETREAL (EREEL, 21 )  ; 


IF  LENGTH  (SREFI.)  on  THEN 
L[I]  :=  VAH3E  (SEEEL,IM)  ; 

END; 

FOR  I:=NR0DIV2+1  TO  NROW  DO 
BEGIN 

NEWI  :=  I-NRODIV2; 

GOTCXY  (52 , 2*NEiJI  )  ; 

IF  L[I]>  =  0  THErj 
WRITE ( •  '  )  ; 

SREEL  := 

ge:treal(GREEL,21)  ; 

IF  LENGTH  (SREEL)  OO  THEN 
L[I]  :=  VALUE (SREEL, P4) ; 

LND; 

END 

ELSE 

FI. AG  :=  TRUE; 

u;;til  flag; 

END;  (*  GETPOLCOF  *) 


PI OCCDURE  PNEN ( I : I NTEGER ; C : CHAR ; £ : STR I NG) 
DEGIN  (*  PMEN  *) 

GOTOXY(0,I)  ; 

IJPITELN  (C:  3  ,  '  ';3,S); 

END;  (*  F(1EN  *) 

PROCEDURE  HEAD(A:STRING;j;INTEGnR) ; 

VAR  I:  INTEGER; 

BEGIN  (*  HEAD  *) 

I  :=  (00-LENGTH (A) )  DIV  2; 

GOTOXY(I,J) ; 

I.'R  ITELN  (A)  ; 

END;  (*  IIE/'D  *) 

PROCEDURE  MATRIXIO; 

VAR  CUITFLAG:  BOOLEAN; 

CHOICE:  CHAR; 

CKSEA:  SETOFCHAR; 

PROCEDURE  EDIT; 

V.M.  EDOUIT:  BOOLEAN; 

EDCHOICE:  CHAR; 


PROCEDURE  AENTER  (AOFB  :CIiAR)  ; 

VAR  I , J ,COLDIM,ROWDIM:  INTEGER; 

tIANAME:  STRING  [3]  ; 

PEG  IN  (*  AENTER  *) 

CLEAKIT ( 1) ; 
lASE  AORB  OF 
' A' :  BEGIN 

AOIFLAG  :=  TRUE; 
REPEAT 
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PF'.OMPTAT  (  2  ,  '  ENTER  DIMENSION  OF  SQUARE  MATRIX 
INTREAD ( ICNDIM) ; 

UNTIL  ((IONDIM>0)  AND  ( lOND I M< 2 1 )  )  ; 

RCWDI'l  :=  ICNDIM; 

COLD  I M  :=  ICNDIM; 

MANAME:='A' ; 

END; 

'B';  BEGIN 

lOEFLAG  :=  TRUE; 

REPEAT 

PRCMPTAT { 2 , • ENTER  PON  DIMENSION  OF  B  ?  '); 
INTREAD (ROND IMB) ; 

UNTIL  ((ROWniMn>0)  AND  (ROWD IMB< 2 1 ) ) ; 

REPEAT 

CLEARIT(l) ; 

PROMPTAT ( 2 , ' ENTER  THE  COLUMN  DIM  OF  B?  '); 
INTREAD ( lOM) ; 

UNTIL  ((IOM>0)  AND  {IOM<21)); 

COLD  I M  ;=  lOM; 

ROV-JDIM  :=  ROWDIMB; 

MANAME: = ' B ' ; 

END; 

END; 

FOR  T:=I  TO  ROWDIM  DO 
FOR  J;=l  TO  CGLDIM  DO 
CASE  AORB  OF 

•A' :  IOTA[I , J]  :=  0.0; 

•B':  IOTB[I,J]  :=  0.0; 

END; 

FOR  J;=l  TO  COLDTM  DO 
BEGIN 

CLEARIT(l)  ; 

WRITELN (’ ENTER  COLUMN  \J,’  OF  MATRIX  MANAME); 
CASE  AORB  OF 

' A'  :  GETCOLUMN (ROWDIM, J, IOTA)  ; 

•B':  GETCOLUMN (ROWDIM, J, 1 0TB)  ; 

END; 

END; 

GLEARIT (1)  ; 

END;  A ENTER  *) 


noCEDURE  AEDIT(AORB:  CHAR); 

VAR  ACHOICE:  CHAR; 

AQU I T , EFLAG :  BOOLEAN ; 

I , J, COLD  I M, ROWDIM:  INTEGER; 
MMIAME:  STRING  [3]; 


BEGIN  (*  AEDIT  *) 

CASE  AORB  OF 
' A' :  BEGIN 

EFLAG  :=  AO  I  FLAG; 
MANAME  :=  'A'; 
ROWDIM  :=  lONDIM; 


'  r^v.»  «:■  IL"  H."  >L~  ^■■', 


COLD I M  :=  lONDIM; 

END; 

•D’:  BEGIN 

EFLAG  :=  lODFLAG; 

MANAME  : =  ' B ' ; 

RC'.JDIM  :=  RCWniMD; 

COLDIM  :=  lOM; 

END; 

END; 

IF  NOT  EFLAG  THEN 
AEHTER (AORB) 

ELSE 

BEGIN 

AQUIT  :=  FALSE; 

REPEAT 

CLEARIT(l) ; 

PMEN(2, 'A'  , 'EDIT  CURRENT  ilATRIX  '); 

PMEN (4, 'B'  , 'CREATE  A  NEW  MATRIX  '); 

Pt'.EN(6,  'Q'  ,  'QUIT')  ; 

GOTOXY(2,8) ; 

WRITE ( ' SELECT  ONE  :  '  )  ; 

OKSET  :=  [ 'A' , 'B' , 'Q' 1 ; 

ACHOICE  :=  GETCHAR (OKSET) ; 

CASE  ACHOICE  OF 

'A';  FOP  I:=l  TO  COLDIM  DO 
BEGIN 

CLEARIT(l) ; 

WRITCLU{ 'ENTER  COLUMN  OF  MATRIX  MANAME) ; 

CASE  ACRE  OF 

'A' :  GETCOLUMN(ROWDIM, I , IOTA) ; 

'B' ;  GETCOLUMN (ROWDIM, I , lOTB)  ; 

END; 

END; 

'B';  BEGIN 

CLEARIT(l); 

GOTOXY(0,2) ; 

WRITE ('DO  YOU  WANT  TO  ERASE  CURRENT  MATRIX  ',  MANAME, 
' ?  Y/N  • ) ; 

CRT (ERASECL) ; 

FOR  l:=l  TO  100  DO  CRT(TIME); 

IF  YES  TflEN 
AENTER (AORB) ; 

END; 

'Q' ;  AQUIT  :=  TRUE; 

END; 

UNTIL  AQUIT; 

END; 

END;  (*  AEDIT  *) 


BEGIN  (*  EDIT  *) 
CLEARSCREEN; 

HEAn( 'MATRIX  EDITOR', 0); 
EDQUIT  ;=  FALSE; 
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aU-t-* 


HE PEAT 

CEEARIT(l)  ; 

PHEN(2, 'A* , 'EDIT  MATRIX  A'); 
PMEt'I{4, 'D' , 'EDIT  MATRIX  B'); 
PMEtJ  (G,  'Q'  ,  'QUIT'  )  ; 

GOTOXY (2,8)  ; 

l.’RITE  (  '  SELECT  DUE  :  '  )  ; 

OKSET  :=  I’A’ , 'D' , ‘Q’ ]  ; 
EDCllOICE  :=  GETCHAR  (OKSET)  ; 
CASE  EDCllOICE  OF 
'A* :  AEDIT('A')  ; 

'B' :  AEDIT( 'D' ) ; 

•Q' :  EDQUIT  :=  TRUE; 

EHD; 

UUTIL  EDQUIT; 

EKD;  (*  EDIT  *) 


*  "Jt  *  > 

'J*  * 

.W.v-I 


•W.’.A' 

.v'. 


PROCEDURE  DISPLAY; 

VAR'  DISQUIT:  BOOLEAN; 
DISCUOICE:  CHAR; 


PROCEDURE  DDISPLA(AORB:CHAR) ; 

VAH  I , J .COLDIMjROHDIM:  INTEGER; 

CM:  CHAR; 

CFLAG:  BOOLEAN; 

MANAME;  STRING  [3]; 

BEGIN  (*  DDISPLA  *) 

CLEARIT(l) ; 

CASE  AORB  OP 
•A';  BEGIN 

CFLAG  :*  AOIFLAG; 

MANAME  ;«  'A'; 

COLDIM  :=  lONDIM; 

ROWDIM  ;=  lONDIM; 

END; 

'B':  BEGIN 

CFLAG  ;=  lOBFLAG; 

MANAME  :=  'B'; 

COLDIM  :=  lOtl; 

ROWDIM  :=  ROWDIMB; 

END; 

END; 

IF  NOT  CFLAG  THEN 
BEGIN 

GOTOXY (0,3)  ; 

WRITE ('THERE  IS  NO  MATRIX  ', MANAME,'  YET  '); 

CRT (ERASEOL)  ; 

FOR  I:=l  TO  100  DO  CRT (TIME); 

SPACEBAR; 

END 

ELSl’. 

BEGIN 

WRITELNCTHE  COLUMNS  OF  MATRIX  ', MANAME,'  ARE:  '); 
FOR  J:=l  TO  COLDIM  DC 
BEGIN 
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WRITELN( 'COLUMN  ’,J,'  OF  ' ,MANAME 

FOR  I;=l  TO  ROWDIM  DO 

DEGIN 

WRITE  (HANAME,  I J 

CASE  AORB  OF 

'A':  WRITELN(IOTA(I ,J] ) ; 

'B':  WRITELN(IGTBII,J]) ; 

END; 

END; 

SPACEBAR; 

END; 

END; 

E!ID;  (*  DDISPLA  *) 

PROCEDURE  HCOPY (AORBrCHAR) ; 

VAR  CH:  CHAR; 

CFLAG:  BOOLEAN; 

MAHAME;  STRING [3]; 

CNUM,I:  INTEGER; 

BEGIN  {*  HCOPy  *) 

CASE  AORD  OF 
•A':  BEGIN 

CFLAG  :=  AOIFLAG; 

MANAME  :=  'A'; 

CNUM  :=  3; 

END; 

'B':  BEGIN 

CFLAG  :=  lOBFLAG; 

MAHAME  :=  'B'; 

CNUM  :=  4; 

END; 

END; 

CLEAP.IT(l)  ; 

IF  NOT  CFLAG  THEN 
BEGIN 

GOTOXY(0,3); 

WRITE( 'THERE  IS  NO  MATRIX  ', MANAME,' 
CRT (ERASEOL) ; 

FOR  I:=l  TO  100  DO  CRT (TIME); 
SPACEBAR; 

END 

ELSE 

HARDCOPY (CNUM) ; 

END;  (*  HCOPY  *) 

BEGIN  {*  DISPLAY  *) 

DISQUIT  :=  FALSE; 

REPEAT 

CLEARSCREEN; 

HEAD ( 'MATRIX  DISPLAY', 0); 

PnEN(2, 'A' , 'SCREEN  DISPLAY  OF  A'); 

P1EN (4, 'B' , 'SCREEN  DISPLAY  OF  B'); 

Pi-IEN  (6, 'C  , 'HARDCOPY  OUTPUT  OF  A'); 

PMEII  (8, 'D' , 'HARDCOPY  OUTPUT  OF  B'); 

PMEN (10, 'O' , 'QUIT'  )  ; 


,'  IS 


YET  '  ) 


GOTOXY(2,12)  ; 


WRITE ( 

'SELECT  ONE  ;  '); 

OKSET 

:=  [ 'A' . . 'D' , 'Q' ] ; 

DISCHOICE  :=  GETCHAR{OKS 

CASE  DISCHOICE  OF 

’  A'  : 

DDISPLA ( ' A' ) ; 

'  B '  : 

DDISPLA( 'B' ) ; 

1  r> '  . 

HCOPY ( ' A' ) ; 

'D'  ; 

HCOPY( 'B' ) ; 

•Q'  : 

DISQUIT  :=  TRUE; 

END; 

UNTIL  DISQUIT; 

END;  (*  DISPLAY  *) 

BEGIN  (*  MATRIXIO  *) 

CLEARSCREEN; 

QUITFLAG  :=  FALSE; 

REPEAT 

CLEARSCREEN; 

HEADC  INPUT  MATRIX  I/0',0); 

PMEN(2, 'A' , 'EDIT  MATRICES* )  ; 

PMEN ( 4 n SCREEN  OR  HARDCOPY  OUTPUT') 
PMEN (6, 'Q','QUIT'); 

GOTCXY  (2,8)  ; 

WR I TE( 'SELECT  ONE  :  ' )  ; 

CKSET  ;=  [ 'A' , 'B' , 'Q' ] ; 

CHOICE  ;=  GETCHAR (OKSET) ; 

CASE  CHOICE  OF 
'A':  EDIT; 

'D':  DISPLAY; 

'Q':  QUITFLAG  ;=  TRUE; 

END; 

UNTIL  QUITFLAG; 

END;  (*  MATRIXIO  *) 


PROCEDURE  HARDCOPY (HNUM: INTEGER) ; 
VAR  F;  TEXT; 

CH:  CHAR; 

PRFLAG:  BOOLEAN; 

RESULT;  INTEGER; 

PROCEDURE  SETPRINT; 

VAR  CH:  CHAR; 

FTRIES:  INTEGER; 

liEGIN  (*  SETPRINT  *) 

PRFLAG  :=  FALSE; 

FTRIES  ;=  0; 

REPEAT 

ASS IGN (F, ' LST: ' ) ; 

REk'RITE  (F)  ; 

IF  IOnESULT=255  THEN 
BEGIN 

FTRIES  :=  FTRIES  +  1; 


•T." 


IF  FTRIES<=2  THEN 
BEGIN 

WRITELNCPUT  PRINTER  ON  LINE  ') 
SPACEBAR; 

END; 

END 

ELSE 

PRFLAG  :=  TRUE; 

UNTIL  PRFLAG  OR  (FTRIES>2); 

END;  (*  SETPRINT  *) 


PROCEDURE  PRSAXB; 

VAR  I,J:  INTEGER; 

BEGIN  (*  PRSAXB  *) 

FOR  J:=l  TO  lOM  DO 
BEGIN 

VJRITELN  (F)  ; 

WRITELN (F, 'THE  SOLUTION  FOR  COLUMN 
FOR  I:=l  TO  lONDIM  DO 
DEGIN 

WRITELN (F,  '  f ' ,XX [ I , J]  ,  •  ]  ’  )  ; 

END; 

END; 

END;  (*  PRSAXB  *) 

PROCEDURE  PRMATRIX(AORB:CMAR) ; 

VAR  DIM,I,J:  INTEGER; 

MAN AMD:  STRING (3]; 

3CGIN(*  PRMATRIX  *) 

CAGE  AORB  OF 
•A’:  BEGIN 

MANAME  :=  'A'; 

DIM  :=  lONDIM; 

END; 

'n':  BEGIN 

MANAME  :=  'B'; 

DIM  :=  lOM; 

END; 

EN'D; 

I TELN  (F)  ; 

iJPITF.LN  (F, 'THE  COLUMNS  OF  MATRIX  MANAME 
..RITELN  (F)  ; 

FOR  J:=l  TO  DIM  DO 
liEGIN 

iJRITELN  (F)  ; 

'.VRITCLN  (F, 'COLUMN  ',J,'  OF  ', MANAME,' 
CASE  AORB  OF 

'A':  FOR  I:=l  TO  lONDIM  DO 

WRITELN (F, 'A(',I,',',J,']=', 
'n':  FOR  I:=l  TO  ROVIDIMB  DO 

WRITELN (F, 'B [ ' ,I , ' , • , J, ' ] =' , 

END; 

END; 

END;  (*  PRMATRIX  *) 


J,'  IS  ') 


, '  ARE:  ') 

IS  :'); 

IOTA [ I , J]  ) 
lOTB I  I , J] ) 
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PROCEDURE  PRRNAA; 

VAR  I,J:  INTEGER; 

BEGIN  (*  PPRNAA  *) 

WRlTELJj  (F)  ; 

ivRITELN  (F, 'THE  ARRAY  OF  COMPLEX  EIGENVALUES  IS'); 
WKITELN (F) ; 

FOR  I:=l  TO  lONDIM  DO 

VJRITF.LN(F,  '  [  '  ,TEVRII]  ,  '  ,  '  ,TEVI  (I]  ,  '  ]  '  )  ; 

WRITELN (F) ; 

WRITELN (F, 'THE  COMPLEX  EIGENVECTORS  ARE  '); 

WRITELN (F) ; 

J  :=  1; 

REPEAT 

IF  TEVI  I  J]  00.0  THEN 
BEGIN 

WRITELN (F) ; 

WRITELN (F, 'VECTOR  ',J,'  IS  '); 

FOR  I:=l  TO  lONDIM  DO 
BEGIN 

WRITE (F, 'VECTOR* , J , ' [ ' , I , * ) = [ ' , TVEC ( I , J] ) ; 
WRITELN (F,  '  , '  ,TVEC(I,J  +  1] 

END; 

WRITELN (F)  ; 

WRITELN(F, 'VECTOR  ',J+1,’  HAS  COMPONENTS  '); 

FOR  I:=l  TO  lONDIM  DO 
BEGIN 

WRITE (F, 'VECTOR' ,J+l,'[',I,’]=l' ,TVEC [I , J) ) 
WRITELN (F, ' , • ,-TVEC [ I , J+1 ),')') ; 

END; 

J  5  =  J  +  2 ; 

END 

ELSE 

BEGIN 

WRITELN (F) ; 

WRITELN {F, ' VECTOR  ',J,'  HAS  COMPONENTS  ' ) ; 

FOR  I;=l  TO  lONDIM  DC 
BEGIN 

WRITE (F, 'VECTOR'  , J , '  [  '  ,  1  ,  '  ]  =  [  '  ,TVEC [ I , J] )  ; 
WRITELN (F, ' , ' ,0.0, ' ) ' ) ; 

END; 

J  :  -  J  + 1 ; 

END; 

UNTIL  J> lONDIM; 

(*  pprnaa  *) 

PIvOCEDURE  PRRDET; 

BEGIN  (*  PRRDET  *) 

..’iaTELN  (F)  ; 

WRITELN  (F, 'THE  DETERMItFANT  OF  MATRIX  A  IS  ’,GSDET); 
END;  (*  PRRDERT  *) 

BEGIN  (*  HARDCOPY  *) 

G ETPRINT; 

IF  PliFLAG  THEN 


CAGE  HNUM  OF 
1;  PRRNAA; 

2:  PRSAXB; 

3:  PRMATRIX ( 'A' ) 
4:  PRMATRIX { 'B' ) 
5:  PRP.DET; 

END; 

CLOSE (F, RESULT) ; 
END; 

END;  (*  HARDCOPY  *) 


MODEND 


(*  VERSION  0285  *) 
MODULE  OVERLAYS; 

(*  EIGEIJUQR  MODULE  *) 


TYPE  DOMAINl  =  1..20; 

MATRIX  =  ARRAY [DOMAINl , DOMAINl]  OF  REAL; 
LI  ST I  =  ARRAY [DOMAINl ]  OF  INTEGER; 

LIETR  =  ARRAY [DOMAINl]  OF  REAL; 

EXTERNAL  PROCEDURE  SPACEBAR; 


PROCEDURE  HQR2 (NM,N,LOE' . IGH: INTEGER;VAR  H:MATRIX;VAR  WR,WI:LISTR 
VAR  Z:MATR1X;VAR  I  ERR : I NTEGER) ; 

CONST  MACHEP  =  l.OE-14; 

VAR  EN,ENM2,I,II,ITS,J,K,L,M,MP2,NA:  INTEGER; 

NORM,  P,Q,R,RA,S,SA,T,  TEMP  1  ,TEMP2,VR,  VI  ,V;,X,Y,ZR,ZI  ,ZZ:  REAL; 
L'EAGl  ,FLAG2  ,FLAG3  ,L-'LAG4  ,NOTLAS,TESTEXIT:  BOOLEAN; 

Cil:  CHAR; 

FUNCTION  SIGN (E,F:REAL) :  REAL; 

BEGIN  (*  SIGN  *) 

IF  F<0  THEN 

SIGN  :=  -ABS(E) 

ELSE 

SIGN  :=  ABS (E)  ; 

END;  (*  SIGN  *) 

FUNCTION  MINO (II, 12: INTEGER) :  INTEGER; 

BEGIN  (*  MINO  *) 

IF  Il<12  THEN 
MINO  :=  II 
ELSE 

MINO  :=  12; 

END;  (*  MINO  *) 

PROCEDURE  COMDIV(XR,XI ,YR,YI :FEAL;VAR  ZR,ZI:REAL); 

VAR  D,H:  REAL; 

BEGIN  (*  COMDIV  *) 

IF  ABS (YR) <ADS (YI )  THEN 
BEGIN 

H  :=  YR/YI; 

D  :=  YI+H*YR; 

ZR  :=  (XR*H+XI ) /D; 

ZI  :=  (XI*H-XR)/D; 

ErjD 

ELSE 

BEGIN 

H  :=  YI/YR; 

D  :=  YR+H*YI; 
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ZR  :=  (XR+H*XI)/D; 
Zl  :=  (XI-H*XR)/D; 
END; 

END;  (*  COMDIV  *) 


PROCEDURE  HQROPTl; 

VAR  I:  INTEGER; 

PROCEDURE  LOOK; 

VAR  I:  INTEGER; 
nEGIN(*  LOOK  *) 

M  :=  ENM2+1; 

FLAG2  :=  FALSE; 

REPEAT 

M  :=  M-1; 

ZZ  : =  H (M,M] ; 

R  :=  X-ZZ; 

S  :=  Y-ZZ; 

P  :=  (R*G-VJ)/H  [M+l,tI] +H  [M,M+1]  ; 

Q  :=  H -ZZ-R-S; 

R  :=  H IM+2,M+1] ; 

S  :=  ABS (P) +ABS (Q) +ADS (R) ; 

P  :=  P/S; 

Q  :=  Q/S; 

R  :=  R/S; 

IF  M=L  THEN 
FLAG2  :=  TRUE 
ELSE 
BEGIN 

TEMPI  ;=  ABS (H ) * (ABS (Q) +ABS  (R)  )  ; 

TEMP2  :=  ABS  (II  [ri-l,M-l]  ) +ABS  (ZZ) +ABS  (I!  [M+1,M+1]  ) 
Ti:;lP2  :=  MACHEP* ABS  ( P)  *TEMP2 ; 

IF  TEMPI  <=  TEMP2  THEN 
FLAG2  :=  TRUE; 

END; 

VJRITE  ('.'); 

UNTIL  FLAG2=TRUE; 

MP2  :=  M+2; 

FOR  I:=MP2  TO  EN  DO 
BEGIN 

H[I,I-2]  :=  0.0; 

IF  IOMP2  THEN 
H  [  I ,  I  -  3 ]  : =  0.0; 

END; 

END; (*  LOOK  *) 


PROCEDURE  DOUBLEQR; 
VAR  K:  INTEGER; 


PROCEDURE  COLMOD 
VAR  I:  INTEGER; 


BEGIN  (*  COLMOD  *) 

FOK  I:=l  TO  J  DO 
BEGIN 

P  :=  X*H [ I ,K] +Y*H  [  I ,K+1 1 ; 

IF  NOTLAS  THEN 
BEGIN 

P  :=  P+ZZ*H [I ,K+2) ; 
II[I,K+2]  :=  H  [  I  ,K+2] -P*R; 

END; 

H(I,K+1]  :=  H [I ,K+1]-P*Q; 

n(I,K]  :=  H(I,K]-P; 

END; 

END;  (*  CCLMOD  *) 

PROCEDURE  ROWMOD; 

VAR  J;  INTEGER; 

BEGIN  (*  ROWMOD  *) 

FOR  J:=K  TO  N  DO 
BEGIN 

P  ;=  n [K, J] +Q*H [K+1, J] ; 

IF  NOTLAS  THEN 
BEGIN 

P  :=  P  +  R*f!  (K+2,J]  ; 
H[K+2,J)  :=  H(K+2,Jl-P*ZZ 

END; 

H[K+1,J]  ;=  H [K+1, J]-P*Y; 

iI(K,J]  :=  H(K,J]-P*X; 

END; 

END;  ROWMOD  *) 


PROCEDURE  ACCTRANS; 

VAR  I:  INTEGER; 

BEGIN {*  ACCTRANS  *) 

FOR  I:=LOW  TO  IGH  DO 
BEGIN 

P  ;=  X*Z (I ,K] +Y*Z [ I,K  +  1]  ; 

IF  NOTLAS  THEN 
BEGIN 

P  :=  P+ZZ*Z [ I ,K+2] ; 
Z[I,K+2]  :=  Z ( I ,K+2]-P*R; 

END; 

Z[I,K+1]  ;=  Z [ I , K+1] -P*Q; 

Z[I,K]  :=  Z[I,K]-P; 

END; 

END; (*  ACCTRANS  *) 

BEGIN (*  DOUBLEQR  *) 

FOR  K:=M  TO  NA  DO 
BEGIN 

FLAGl  ;=  FALSE; 

NOTLAS  :*  KONA; 

IF  KOM  THEN 
BEGIN 

P  HtK,K-l]  ; 
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Q  :»  n[K+l,K-l] ; 

k  :=  0.0; 

IF  tlOTLAS  THEN 
R  :=  H  (K  +  2,K-1] ; 

X  :=  ABS (P) +AHS (Q) +ABG (R) ; 
IF  X=0.0  THEN 
FLAGl  :=  TRUE 
ELSE 
BEGIN 

P  :=  P/X; 

Q  :=  Q/X; 

R  :=  R/X; 

END; 

END; 

IF  FLAG1=FALSE  THEN 
BEGIN 

S  ;=  P*P+Q*Q+R*R; 

S  :=  GQKT(S) ; 

S  :=  SIGN (S,P)  ; 

IF  K=M  THEN 
BEGIN 

IF  LOM  THEN 

H(K,K-1]  :=  -H[K,K-1] 

END 

ELSE 

H[K,K-11  :=  -S*X; 

P  ;=  P+S; 

X  ;=  P/S; 

Y  :=  Q/S; 

ZZ  :=  R/S; 

Q  :=  Q/P; 

R  :=  R/P; 

ROVIMOD ; 

WRITE ( ' . ' ) ; 

J  :=  MINO (EN,K+3) ; 

COLMOD; 

WRITE 

ACCTRANS; 

WRITE( • . ' ) ; 

END; 

END; 

;d; (*  DOUBLEQR  *) 


BEGIN  (*  HQROPTl  *) 

TECTEXIT  :=  FALSE; 

IF  ITS>=100  THEN 
BEGIN 

lERR  ;=  EN; 

WRITELNCTHE  ITERATION  LIMIT  OF  100  HAG  BEEN  ') 
WRITELNC  REACHED  IN  -HQR-'); 

SPACEBAR; 

TESTEXIT  :=  TRUE; 

END 

ELSE 

BEGIN 


IF  (ITSOO)  AND  (ITS  MOD  10  =  0)  THEN 
BEGIN 

T  :=  T+X; 

FOR  I:=LOW  TO  EN  DO 
H[I,I]  :=  11[I,I1-X; 

S  :=  ABS  (H  [Et:,NA]  ) +ABS  (H  [NA,EMM2]  ) 
X  :=  0.75*S; 

Y  :=  X; 

W  :=  -0.4375*S*S; 

END; 

ITS  :=  ITS+1; 

LOOK  ; 

DOUBLEQR; 

END; 

END; (*  HQROPTl  *) 

PROCEDURE  HQROPT2; 

PROCEDURE  ROWMOD2; 

VAR  J:  INTEGER; 

EEGIN(*  ROWMOD2  *) 

FOR  j:=na  to  n  do 

BEGIN 

'LZ  :  =  H  [ NA ,  J ]  ; 

H(NA,J1  ;=  Q*ZZ+P*H [EN, Jl ; 

H[EN,J1  ;=  C*H [EN, J] -P*ZZ; 

END; 

CND;(*  R0WM0D2  *) 


PROCEDURE  C0LM0D2; 

VAR  I:  INTEGER; 

BEGIN (*  COLMOD2  *) 

FOR  l;=l  TO  EN  DO 
BEGIN 

ZZ  :=  H [ I ,NA] ; 

H[I,NA)  :=  Q*ZZ+P*H [I ,EN] ; 
H[I,EN]  :=  Q*H[I,EN]-P*ZZ; 
END; 

END; (*  COLMOD2  *) 

PROCEDURE  ACCTRANS2; 

VAR  I;  INTEGER; 

BEGIN  (*  ACCTRANS2  *) 

FOR  I:=L0W  TO  IGH  DO 
BEGIN 

ZZ  : =  Z [ I ,NA] ; 

Z(I,NA]  ;=  Q*ZZ+P*Z [ I ,EN] ; 
Z[I,EN]  :=  C*?- [  I /EN] -P*ZZ; 
END; 

END; (*  ACCTRANS2  *) 


BEGIN  (*  HQROPT2  *) 
P  :=  {Y->:)/2.0; 


Q  :=  P*P+W; 

'I'L  :=  SgnT(AnS{Q)  )  ; 
11[EN,EN1  :=  X  +  T; 

X  :=  II  [LN,EN]  ; 
H(NA,NA]  :=  Y+T; 

IF  Q<0.0  THEN 
BEGIN 


WR[NA] 

;=  X+P; 

WR [EN] 

:=  X+P; 

WI [NA] 

;=  ZZ; 

WI [EN] 

:=  -ZZ; 

END 

ELSE 

BEGIN 

XZ  :=  P+SIGN {ZZ,P) ; 
\JR[NA]  :=  X  +  ZZ; 
WR[Eti]  ;=  WR(NA]; 

IF  ZZOO.O  THEN 
WR(EH]  :=  X-W/ZZ; 
IJI  [NA]  :=  0.0; 

WI(EN1  :=  0.0; 

X  :=  H [EN,NA] ; 

R  :=  SORT (X*X+ZZ*ZZ) 
P  :=  X/R; 

Q  :=  ZZ/R; 

ROWMOD  2 ; 

WRITE( ' . ' )  ; 

COLI1GD2; 

U'RITE(  '  .  '  )  I 
ACCTRANS2; 

WRITE 

END; 

EH  :=  ENM2; 

IF  EN>=  LOW  THEN 
BEGIN 

ITS  :=  0; 

NA  :=  EN-1; 

EHM2  ;=  NA-1; 

END 

ELSE 

FLAG3  :=  TRUE; 

EHD;(*  HQROPT2  *) 

PROCEDURE  EIGENVECTOR; 

VAR  EN,I,J;  INTEGER; 

PROCEDURE  LOOP700; 

VAR  I,II,J;  INTEGER; 

TTP:  REAL; 

BEGIN(*  LOOP700  *) 

WRITE ; 

FOR  II;=1  TO  NA  DO 
BEGIN 
I  :  = 


EN-II 


R  :=  H  tl ,EN]  ; 

IF  M<=NA  THEN 

FOR  J:=M  TO  NA  DO 
BEGIN 

IF  (H[I,J]=0.0)  OR  (H(J,EN] =0.0)  THEN 
TTP  :=  C.O 
ELSE 

TTP  :=  H  [I  , J1*H(J,EM] ; 

R  :=  R+TTP; 

END; 

IF  WI  [I] <0.0  THEN 
BEGIN 

ZZ  :=  VI ; 

S  :=  R; 

END 
ELSE 
BEGIN 
M  :  =  I  ; 

IF  WI  [I  ] =0.0  THEN 
BEGIN 

T  :=  W; 

IF  W=0.0  THEN 

T  :=  MACHEP*NORM; 

H(I,EN]  :=  -R/T; 

END 

ELSE 

BEGIN 

X  :=  H(I,I  +  11  ; 

Y  :=  Hll  +  l,n; 

Q  :=  (WR(I]-P)*(WR[I]-P)+WI fI]*WI (1) 
T  :=  (X*S-ZZ*R)/Q; 

H[I,EN]  :=  T; 

IF  ABS (X) >ABS (ZZ)  THEN 
H[I+1,EN]  :=  (-R-W*T)/X 

ELSE 

H[I+1,EN]  :=  (-S-Y*T)/ZZ; 

END; 

END; 

END; 

END; (*  LOOP700  *) 


PROCEDURE  LOOP790; 

VAR  II,J:  INTEGER; 

PROCEDURE  LOOPWORK; 

BEGIN  (*  LOOPWORK  *) 

X  :  =  II  [  I  ,  I  +  l]  ; 

Y  :=  H[I+1,I1  ; 

VR  :=  (WR  [  I  1 -P)  *  (WR  [  I  ] -P) +WI  ( I  ]  *VJI  [  I ) -Q*Q; 
VI  :=  (WR [ I ] -P) *2 . 0*Q; 

IF  (VR=0.0)  AND  (VI=0.0)  THEN 

VR  :=  MACI!EP*NORM*  (ABS  (VJ) +ADG  (Q)  + 

ADS (X) +ABN (Y) +ABS (ZZ) )  ; 

COMD  I V  (  X *  R-  Z  Z  *  KA-i  Q*  SA  ,  X *  G-  Z Z  *  S A- Q*  R A  , 


VR,VI ,ZR,ZI) ; 

H[IfNA]  :=  ZR; 

H[I,EH]  :=  Zl; 

IF  ADS (X) > (ADS (ZZ) +ADS (Q)  )  THEN 
DEGIN 

H[I+1,NA]  :=  {-RA-W*H(I,NA]+Q*H[I,EN1 )/X; 

HII+1,EN]  :=  (-SA-W*H[I,EN)-0*n[I,NAl )/X; 

END 

ELSE 

BEGIN 

COMDIV(-R-Y*H(I,NA] , - S-Y*n ( I , EN ] ,ZZ,Q,ZR,ZI) 
H[I+1,NA]  :=  ZR; 

H[I+1,EN]  :=  ZI; 

END; 

END;  (*  LOOPVJORK  *) 

BEGIN (*  LOOP790  *) 

FOR  II:=1  TO  ENM2  DO 
BEGIN 
WRITE 

I  ; =  NA- 1 1 ; 

W  :=  H[I,I]-P; 

RA  :=  0.0; 

SA  :=  H(I,EN]  ; 

FOR  J:=M  TO  NA  DO 
DEGIN 

RA  ;=  RA+H [I , J1 *H (J,NA] ; 

SA  ;=  SA  +  H ( I , J] *H [ J ,EN)  ; 

END; 

IF  WI [I]<0.0  THEM  i 

BEGIN 

Z  Z  ;  =  W  ; 

R  :=  RA; 

G  :=  SA; 

END 

ELSE 

BEGIN 

M  ;  =  I ; 

IF  WI ( I ] =0.0  THEN 
BEGIN 

COMDIV (-RA,-5A,W,Q,ZR,ZI) ; 

H(I,NA]  :=  ZR; 

H(I,EN]  ;=  ZI; 

END 

ELSE 

LOOPWORK; 

END; 

END; 

END; {*  LOOP790  *) 


PROCEDURE  LOOPRSO; 
V\R  1,J,K:  INTEGER; 


BEGIN(*  LOOPD80  *) 

FOR  J:=N  DOWNTO  LOW  DO 
BEGIN 
WRI TE 

M  :=  MIMO ( J , IGH)  ; 

FOR  I:=LOW  TO  IGll  DO 
BEGIN 

ZZ  :=  0.0; 

FOR  K:=LCW  TO  M  DO 

ZZ  :=  ZZ+Z [ I ,K] *H [K,J] ; 

Z  [  I ,  J  ]  :  =  Z  Z  ; 

END; 

END; 

e:;d;  (*  loops 80  *) 

PROCEDURE  PRELOOP; 

BEGIN  (*  PRELOOP  *) 

M  :=  NA; 

IF  ABS  (H  (EN,NA]  )  >ABS  (II  [NA,ENl  )  THEN 
BEGIN 

M[HA,NA]  :=  C/H[EN,NA]; 

H[NA,EN]  :=  -  (II  [  EN  ,  CN  ] -P) /H  I EN ,  NA]  ; 

END 

ELSE 

BEGIN 

COMDIV(0.0,-H[NA,EN]  , H  [ NA , NA ] - P , Q , Z R , Z I ) 
1I[NA,NA]  :=  ZR; 

H  ( NA  ,  EN  ]  :  =  Z I  ; 

END; 

H(EN,NA]  :=  0.0; 
ll[EN,EN]  ;=  1.0; 

EN:12  :=  NA-1; 

END;  (*  PRCLOOP  *) 

BEGItK*  EIGENVECTOR  *) 

NORM  :=  0.0; 

K  :=  1; 

FOR  l:=l  TO  N  DO 
BEGIN 

FOR  J:=K  TO  N  DO 

NORM  :=  NORM+ABS (H ( I , J] ) ; 

K  :=  I; 

END; 

ir  IJORMOO.O  THEN 
BEGIN 

FOR  EN;=N  DOWNTO  1  DO 
BEGIN 

P  :=  WR [EN] ; 

Q  :=  WI[EN]; 

NA  :=  EN-1; 

IF  Q<=0.0  THEN 
BEGIN 

IF  Q=0.0  THEN 
BEGIN 


H[EN,EtJ]  :=  1.0; 
IF  NAOO  THEN 
LOOP700; 

END 

ELSE 

BEGIN 

PRELOOP; 

IF  ENM2O0  THEN 
LOOP790; 

END  ; 

END; 

END; 

FOR  l:=l  TO  N  DO 

IF  (I<LOV^)  OR  (I>IGH)  THEN 
FOR  J:=I  TO  N  DO 
Z[I,J]  :=  n[I,J] ; 
LOOP880; 

END; 

END; (*  EIGENVECTOR  *) 


BEGIN(*  HQR2  *) 

I  ERR  :=  0; 

FOR  I : =1  TO  N  DO 
BEGIN 

IF  (I<LOW)  OR  (I>IGH)  THEN 
BEGIN 

NRd]  ;=  H[I,I1; 

VJI  [I  ]  :=  0.0; 

END; 

END; 

EN  :=  IGH; 

T  :=  0.0; 

IF  £N>=LOW  THEN 
BEGIN 

IT.S  :=  0; 

NA  :=  EN-1; 
i:n,12  ;=  NA-1; 

FLAG 3  :=  FALSE; 

I’.LPEAT 

FLAG4  :=  FALSE; 

L  :=  EN+1; 

REPEAT 

L  :=  L-1; 

IF  L=LOW  THEN 
FLAG4  :=  TRUE 
ELSE 

IF  ABS  (H  [L,L-1]  )  <=MACHEP*  ( ABS  ( H  [  L- 1  ,  L- 1  ]  )  +ABS  (II  [L,L]  ) 
)  THEN 

FLAG4  :=  TRUE; 

UNTIL  FLAG4=TRUE; 

X  :=  H [EN,EN]  ; 

IF  LOEN  THEN 
BEGIN 

Y  :  =  H  (NA,N‘A]  ; 

V;  :=  HiEN,NA]  *1!  [NA,EN1  ; 


IF  LONA  THEN 
BEGIll 

HQROPTl; 

IF  TESTEXIT  THEN 
EXIT; 

END 

ELSE 

11CR0PT2; 

END 

ELSE 

BEGIN 

n[EN,EN]  :=  X+T; 
WR[EN]  ;=  H[EN,EN1; 
WI [EN]  :=  0.0; 

EM  :=  NA; 

IF  EN>=L0W  THEN 
BEGIN 

ITS  :=  0; 

NA  ;=  EN-1; 

ENM2  :=  NA-1; 

END 

ELSE 

FLAG3  ;=  TRUE; 

END; 

UNTIL  FLAG3; 

EIGENVECTOR; 

END; 

END;  (*  IIQR2  *) 


MODEND 


(*  VERSION  0286  *) 
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MODULE  OVERLAYS; 

(*  MODULE  EIGEtJBAL  *) 

TYPE  DOMAINl  =  1..20; 

MATRIX  =  ARRAY [DOMAIMl, DOMAINl]  OF  REAL; 

LI  ST  I  =  ARRAY [DOMAINl]  OF  INTEGER; 

LISTR  =  ARRAY [DOMAINl]  OF  REAL; 

PROCEDURE  ELMIIES  (NM,N  ,LOVI,  IGU  :  INTEGER;  VAR  A:MATRIX;VAR  INT:LISTI); 
VAR  I , J ,KP1,LA,M,MM1 ,MP1 :  INTEGER; 

X,Y:  REAL; 

BEGIN  (*  ELMHES  *) 

LA  :=  IGII-1; 

KPl  :=  LOVJ+1; 

IF  LA>=KP1  THEN 
BEGIN 

FUR  M:=EP1  TO  LA  DO 
BEGIN 

MMl  :=  M-1; 

X  :=  0.0; 

I  :  =  M  ; 

FOR  J:=M  TO  IGH  DO 
BEGIN 

IF  AnS(A[J,MMl] )>ABS(X)  THEN 
BEGIN 
V/RITE 

X  ;=  A[J,MM1] ; 

I  :=  J; 

END; 

END; 

INT[M1  :=  I; 

IF  lOM  THEN 
BEGIN 

FOR  J:=MM1  TO  N  DO 
BEGIN 

Y  : =  A[I,J]; 

A[I,J]  :=  A[M,J] ; 

A[H,J]  :=  Y; 

END; 

FOR  J:=l  TO  IGH  DO 
BEGIN 

Y  ;=  A[J,I] ; 

A[J,I]  :=  A[J,M] ; 

A[J,M]  :=  Y; 

END  ; 

END; 

IF  XOO.O  THEN 
BEGIN 

MPl  :=  M+1; 

FOR  I:=MP1  TO  IGH  DO 
BEGIN 

Y  :=  A[I,MM1] ; 
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IF  YOO.O  THEN 
BEGIN 
WRITE 
Y  :=  Y/X; 

A[1,MM1]  ;=  Y; 

FOR  J : =M  TO  N  DO 

AII,J]  :=  A(I,J]-Y*A[M,J] 
FOR  J:  =  l  TO  IG!I  DO 

A(J,M1  :=  A[J,M]+Y*A1J,I] 

END; 

END; 

END; 

END; 

END; 

END;  (*  ELMIiES  *) 


PROCEDURE  ELTRAN(NM,N,LOW,  IG1I:INTEGER;A:MATRIX; 

JN: LI  ST  I; VAR  ZrMATRIX); 

VAR  I,J,KL,MM,MP,I1P1:  INTEGER; 

BEGIN {*  ELTRAN  *) 

FOR  I;=l  TO  N  DO 
BEGIN 

FOR  J;=l  TO  N  DO 
ZII,J]  :=  0.0; 

Z[I,I]  :=  1.0; 

END; 

KL  :=  JGK-LOW-1; 

IF  KL>=1  THEN 
BEGIN 

FOR  TO  KL  DO 

BEGIN 

MP  :=  IGH-MM; 

MPl  ;=  MP+1; 

FOR  I:=MP1  TO  IGII  DO 
Z[I,t1P]  :=  A[I,MP-1]  ; 

I  ;=  JN[MP]; 

WRITE ('.' )  ; 

IF  lOMP  THEN 
BEGIN 

FOR  J:=MP  TO  IGII  DO 
BEGIN 

Z[MP,J]  :=  Z[I,J1; 

Z[I,J]  :=  0.0; 

END; 

Z[I,HP1  :=  1.0; 

END; 

END; 

END; 

END;(*  F.LTRAN  *) 

PROCEDURE  nALnAK(NM,N,LCW,  IGII;  INTEGEP;SCALE  :  LISTR 

M: INTEGER;VAR  Z;MATRIX); 


V  mV'  irj  IT. 


VAR  I,J,K,II:  INTEGER; 

S:  REAL; 

BEGIN (*  3ALBAK  *) 

IF  IGUOLCW  THEN 
BEGIN 

FOR  I:=LOW  TO  IGH  DO 
BEGIN 

G  : =  SCALE ( I ]  ; 

FOR  J:=l  TO  M  DO 

ZtI,J]  :=  Z[I,D]*S; 

END; 

END; 

FOR  Il:=l  TO  N  DO 
BEGIN 

1  : =  II; 

IF  (I<LOVJ)  OR  (I>IGH)  THEM 
BEGIN 

IF  I<LOW  THEN 
I  : =  LOW- 1 1 ; 

K  :=  TRUNC (SCALE ( I ] )  ; 

IF  KOI  THEN 
BEGIN 

WRITE ( ' . ' ) ; 

FOR  J;=l  TO  t1  DO 
BEGIN 

S  :=  Z[I,J)  ; 

Z(I,J]  5=  Z[K,J]; 

Z[K,J]  :=  S; 

END ; 

END; 

END; 

END; 

END; (*  BALBAK  *) 

PROCEDURE  BALANCE (NM,N : INTEGEH;VAR  A:MATRIX;VAR  LOW , I GH : I NTEGER 

VAR  SCALErLISTR) ; 

CONST  RADIX  =  2.0; 

VAR  FLAGA, FLAGS, FLAGC,FLAGD,FLAGl,FLAG2,HCCONV;  BOOLEAN; 

I , lEXC, J,K,L,M:  INTEGER; 

32,C,F,G,R,S:  REAL; 

PROCEDURE  ROWSEARCH; 

BEGIN  (*  ROWSEARCH  *) 

J  :=  L+1; 

FLAGA  :=  TRUE; 

REPEAT 

J  : =  J-1  ; 

I  :  =  0  ; 

FLAG2  :=  FALSE; 

FEPE//r 

I  :=  I+l; 

IF  lOJ  THEN 
BEGIN 
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IF  A(J,I]  00.0  THEN 
FLAG2  :=  TRUE; 

END; 

UNTIL  (I=L)  OR  (FLAG2=TRUE) ; 
IF  NOT  FLAG2  THEN 
BEGIN 
M  :=  L; 
lEXC  ;=  1; 

FLAGA  ;=  FALSE; 

END; 

UNTIL  (J=l)  OR  (FLAGA=FALSE) ; 
END;  (*  ROVJSEARCH  *) 


PROCEDURE  COLUMNSEARCH; 

UKCIN  (*  COLUMNSEARCH  *) 

J  :=  K-1; 

PLACE  :=  TRUE; 

Pi;  PEAT 

J  :=  J+1; 

I  :=  K-1; 

FLAGl  :=  FALSE; 

REPEAT 

I  :=  I+l; 

IF  lOJ  THEN 
BEGIN 

IF  A[I,J]<>0.0  THEM 
FLAGl  :=  TRUE; 

END; 

UNTIL  (I*L)  OR  (FLAG1=TRUE) i 
IF  NOT  FLAGl  THEN 
BEGIN 
M  ;=  K; 
lEXC  ;=  2; 

FLAGS  :=  FALSE; 

END; 

UNTIL  (J=L)  OR  (FLAGB=FALSE) ; 
END;  (*  COLUMNSEARCH  *) 


PROCEDURE  NORMREDUCTION; 

VAR  I,J;  INTEGER; 

begin  (*  NORMREDUCTION  *) 

PGR  I:=K  TO  L  DO 
BEGIN 

C  :=  C.O; 

R  ; =  0.0; 

FOR  J;=K  TO  L  DO 
BEGIN 

IF  JO  I  THEN 
BEGIN 

C  :*  C+ABS(A[J,I1) 
R  ;=  R  +  ABS (A  (  I  , J] ) 


G  :=  R/RADIX; 

WRITE ( '  .  ' )  ; 

F  :=  1.0; 

S  :=  C+R; 

WHILE  C<G  DO 
BEGIN 

F  :=  F*RADIX; 

C  ;=  C*B2; 

END; 

G  :=  R* RADIX ; 

WHILE  C>=G  DO 
BEG  I  N 

F  :=  F/RADIX; 

C  :=  C/D2; 

END; 

IF  ( (C+R)/F)<(0.95*S)  THEN 
BEGIN 

G  ;=  1.0/F; 

SCALE[I1  :=  SCALE [I] *F; 
NOCONV  :=  TRUE; 

FOR  J:=K  TO  N  DO 

A[I,J]  :=  AII,J]*G; 
FOR  J;=l  TO  L  DO 

A[J,I]  :=  A(J,I]*F; 

END; 

END  ; 

END;  (*  NORMREDUCTION  *) 


BEGIN  (*  BALANCE  *) 
n2  :=  RADIX* RADIX; 

K  :=  1; 

L  :  =  ; 

FLAGD  ;=  FALSE; 

WHILE  NOT  FLAGD  DO 

begin 

FLAGD  ;=  TRUE; 

FLAGD  :=  FALSE; 

KOWSEARCH; 

IF  FLAGA  THEN 
COLUMNSEARCH; 

IF  NOT  FLAGB  THEN 

begin 

REPEAT 

SCALE [M]  :=  J; 

IF  JOM  THEN 
BEGIN 

FOR  I:=l  TO  L  DO 
BEGIN 

F  :  =  A  [  I ,  J  ]  ; 
A(I,J)  :=  A[I,M] ; 
A[I,M]  :=  F; 

END; 

FOR  I;=K  TO  N  DO 
BEGIN 

F  :=  AIJ,I1; 


■A.V 


AfJ,I]  := 
A[M,I]  := 

END; 

END; 

IF  IEXC=1  THEN 
FLAGC  ;=  TRUE 
ELSE 

FLAGC  :=  FALSE; 

IF  HOT  FLAGC  THEM 
BEGIN 

K  :=  K+1; 
COLUMMSEARCH; 

END; 

WRITE 

UNTIL  FLAGC  OR  FLAGB; 

IF  NOT  FLAGB  THEN 
BEGIN 

IF  LOl  THEN 
BEGIN 

FLAGD  :=  FALSE; 
L  :=  L-1; 

END; 

END; 

END; 

END; 

IF  FLAGB  THEN 
BEGIN 

FOR  I:=K  TO  L  DO 
SCALEHl  ;=  1.0; 

REPEAT 

NOCONV  ;=  FALSE; 
NORMREDUCTION; 

UNTIL  NOT  NOCONV; 

END; 

LOW  :=  K; 

Mil  ;=  L; 

END;  (*  BALANCE  *) 


MODEND. 


rr]  > 


{*  vr'r;JiotJ  028  5  *) 
(*  MODULE  DETERM  *) 


MODULE  OVERLAY19; 

TYPE  DOMAIHl  =  1..20; 

MATRIX  =  ARRAY [DOMAIHl ,DOMA TNI]  OF  REAL; 
LI  ST  I  =  ARRAY [DCMAINl]  OF  INTEGER; 

LISTR  =  ARRAY  [DOMAir.'l]  OF  REAL; 


VAR  lONDIM;  EXTERNAL  INTEGER; 
AO  I  FLAG:  EXTERNAL  UOOLEAN; 
IOTA:  EXTEIJAL  MATRIX; 
GSDET:  EXTERNAL  REAL; 


EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 


PROCEDURE  CLEARSCREEN; 

PROCEDURE  SPACEBAR; 

FUNCTION  YES:  BOOLEAN; 

[3]  PROCEDURE  HARDCOPY (HNUM: INTEGER) ; 

[1]  PROCEDURE  RLUD (ND,N: INTEGER; VAR  KER : INTEGER ; VAR  ALU 

MATRIX; 

VAR  JN:LISTI;  VAR  SCALE : LI STR)  ; 


PROCEDURE  TTRDET; 

VAR  TKER:  INTEGER; 

TSCALE:  LISTR; 

TIN:  LISTI; 

SDET:  REAL; 

I , J,PDEG,NT: INTEGER; 
C'lOICE, SELECTION:  CHAR; 
'ICOEF:  LISTR; 

TVJI,TWR:  LISTR; 

I  ERR:  INTEGER; 

CN:  CHAR; 

SREI:L:  STRING; 

P-^:  INTEGER; 
TALU:MATRIX; 


PROCEDURE  F.DET  ( SND ,  SN  :  I NTEGER ;  VAR 
VAR  SA;MATRIX); 


SKER: INTEGER;VAR  DET:REAL; 


VAR  J:  INTEGER; 
CJN:  LISTI; 
ESCALE:  LISTR; 
l;:  STRING; 

Cil:  CHAR; 


BEGIN  (*  RDET  *) 

S[:ER  :=  0; 

RLUD (SND, SN, SKER, SA,£JH,SSCALE)  ; 


DET  :=  SJN[SN]; 

FOR  J:=l  TO  St;  DO 
DET  :=  DCT*SA(J,J]; 

RDCT  *) 

BEG  It;  (*  TTRDET  *) 

CLEA R SCREEN, • 
tJT  :=  lONDIM; 

FOR  I:=l  TO  NT  DO 
ECR  J;=  1  TO  NT  DO 

TALU [T , J]  ;=  IOTA[ I , J] ; 

CLEAR.SCREEN; 

WniTELN  (' PLEASE  VJAIT  '); 

RDE'i'  (NT,NT,TKER,SDET,TALU)  ; 

CLEARSCREEt;; 

IF  TKER=0  THEN 
BEEIN 

GSDET  :=  SDET; 

WRITELN; 

WR  I  TEEN  ('THE  DETERM  I  tIANT  =  '.SDET); 
SPACEBAR; 

'JRITELN; 

'..'RITE  ('DC  YOU  UAt.’T  A  HARDCOPY?  Y/N  ') 
IF  YES  THEN 
HARDCOPY (5) ; 

END; 

END;  {*  TTR.OET  *) 


MODFND 


{*  vrr:3ior]  30 o  *) 
(*  AX  =  B  MCDUr.b:  *) 
MOiniLi;  OVERLAY 20; 


TYPC  DOMAINl  =  1..20; 

MATRIX  =  ARRAY (DOMAINl ,D0MAIN1 )  OF  REAL; 
LI3TI  =  ARRAY [DCMAIta]  OF  INTEGER; 

LIJTR  =  ARRAY [DOMAIN] ]  CF  REAL; 


VAR  IOTA , IOTB,XX;  EXTERNAL  MATRIX; 

ACIFLAG,  lODFLAG:  EXTERN/AL  BOOLEAN; 

IONDIM,IOM:  EXTERNAL  INTEGER; 

EXTERNAL  FUNCTION  YES:  BOOLEAN; 

EXTERNAL  PROCEDURE  SPACEBAR; 

EXTERNAL  PROCEDURE  CLEARSCREEM; 

EXTERNAL  [1]  PROCEDURE  RLUD ( ND , N : INTEGER ; VAR  K EP : INTEGER ; VAR  ALU 

MATRIX; 

VAR  JNtLISTI;  VAR  SCALE : L I STR) ; 

EXTERNAL  [1]  PROCEDURE  RFBS (ND,N : INTEGER; VAR  KER : INTEGER; VAR  ALU 

MATRIX; 

VAR  JN:LISTI;  VAR  XlLISTR); 

EXTERNAL  [3]  PROCEDURE  HARDCOPY (HNUM ; INTEGER); 


PROCEDURE  TTGAXD; 

VAR  QUITFLAG:  BOOLEAN; 
I,J,PDEG;  INTEGER; 
CHOICE, SELECTION:  CHAR; 
TCOEF:  LISTR; 

T'..'I,TWR:  LISTR; 
IERiaMT,NT:  INTEGER; 

CII:  CHAR; 

SREEL:  STRING; 

P^:  ItJTEGER; 

TKER:  ItiTEGER; 

Tr:CALE:  LISTR; 

TIL':  LI  ST  I; 

TINIT:  INTEGER; 

TALU ,Tn: MATRIX; 


PROCEDL'PE  SAXB  (SND,SN,SM:  INTEGER;VAR  SA  :  MATR  I X  ;  VAR 
VAR  SINIT: ]NTECER;VAR  S JN : L I  ST  I ; VAR 
VAR  I,J,NN:  INTEGER; 

.’Q, SCALE:  LISTR; 

BEGIN  (*  SAXB  *) 
lUi  :=  SN; 

IF  EINIT=0  THEN 


SB, SX: MATRIX; 
SKEK : 1 NTEGER) 
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RLOD  (S:JD,SN,SKER,SA,KJN  .SCALE)  ; 

IF  SJi;(S[J]=0  THEN 
BEGIN 

S  K  E  R  :  =  3 ; 

WRITELN; 

LRITELNCIN  SAKE,  LU  DECOMPOSITION  OF  A  '); 
WRITELN (' YIELDED  A  SINGULAR  U  .  A  UNIQUE  ') 
WRITELN( 'SOLUTION  nOES  NOT  EXIST.'); 
SPACEBAR; 

EX  I  T ; 

END; 

IF  SM<=0  THEN 
BEGIN 

SKER  :=  0; 

EXIT; 

END; 

FOR  J:=l  TO  SM  DO 
BEGIN 

FOR  I:=l  TO  NN  DO 
Bn[I]  ;=  SB[I,J] ; 

RFBS (SND,SN,SKER,SA,SJN,nB) ; 

FOR  I:=l  TO  NN  DO 
SX [ I , J]  ; =  DO [ I ] ; 

END; 

V/RITELN; 

END;  {*  SAXB  *) 


BEGIN (*  TTSAXB  *) 

CLEARSCREEN; 

NT:=  lONDlM; 
riT;=  io:i; 

TIN  IT  :=  0; 

FOR  l:=l  TO  NT  DO 
FOR  J;=  1  TO  NT  DO 

TALU [ I , J]  : =  IOTA ( I , J] ; 

FOR  J:=l  TO  ilT  DO 
FOR  I:=l  TO  NT  DO 

TB[I,J]  ;=  IOTD[I,J] ; 

CLEARSCREEN; 

WRITELN (' PLEASE  WAIT  '); 

SAXB  (:;T,NT,MT,TALU,TB,XX  ,TINIT,TIN,TKER)  ; 
CLEARSCREEN; 
ir  TKi:R  =  0  THEN 
BErilN 

FOR  J:=l  TO  MT  DO 
B  EG  I  N 

WRITELN ('THE  SOLUTION  FOR  COLUMN  ',J,'  IS 
FOR  l:=l  TO  NT  DC 
BEGIN 

WRITE ( ' ( ' ) ; 

WRITE {XX ( I , J] ) ; 

WRITELN (']'); 

END ; 

SPACEBAR; 

WRITELN; 


(*  VKKTJIOtJ  1283  *) 

(*  POLYROOT  MODULE  *) 

MODULE  CVERLAY21; 

CONST  MAXDEGPl  =  21; 
MAXDEC  =  20; 


TYPE  DOMAINl  =  1..20; 

DOMRPl  =  1.. MAXDEGPl; 

MATRIX  =  ARRAY [DOMAINl, DOMAINl]  OF  REAL; 
LISTI  =  ARRAY [DOMAINl ]  OF  INTEGER; 

LIETR  =  ARRAY [DOMAINl]  OF  REAL; 

LISTRPl  =  ARRAY [DOMRPl]  OF  REAL; 


EXTERNAL  PROCEDURE 
EXTERNAL  PROCEDURE 
EXTERNAL  PROCEDURE 
EXTERNAL  PROCEDURE 


CLEARSCREEN; 
CLEARIT{I:INTEGER) ; 
INTREAD (VAR  K: INTEGER); 
SPACEBAR; 


EXTERNAL  [3]  PROCEDURE  GETPOLCOF (NROW: INTEGER ; VAR  TCOEF : LI STRPl ) ; 


EXTERNAL  [5]  PROCEDURE  HQR2 ( NM , N , LOW , I GH : 1 NTEGER ;  VAR  H:MATRIX;  VAR 

WR,WI : 

LISTR;  VAR  ZrMATRIX;  VAR  I  ERR : I NTEGER )  ; 

EXTERNAL  [6]  PROCEDURE  B ALANCE ( NM , N : I NTEGER ;  VAR  ArMATRIX;  VAR  LOW, 

IGll: 

INTEGER;  VAR  SCALE:  LISTR) ; 

EXTERNAL  [6]  PROCEDURE  ELMHES (NM,N, LOW, IGH : INTEGER;  VAR  AlMATRIX; 

VAR  TNT: 

LISTI) ; 

EXTERfiAL  [6]  PROCEDURE  ELTKAN  ( NM ,  N ,  LOW ,  I GU  :  I  NTEGER ;  VAR  A:MATRTX; 

JN:  LISTI; 

VAR  Z:  MATRIX); 


PROCEDURE  TTRPQR; 

VAE  '^UITPLAG:  BOOLEAN; 
I,U,PDEG:  INTEGER; 

Clio  ICE,  SELECT  I  ON:  CHAR; 
PI'.COEE:  LI  STRPl; 
'i,n,T',;R:  LISTR; 
TIi:i<k,MDF,G:  INTEGER; 

Cl!:  CHAR; 

SRI:EL:  STRING; 

P*;  :  INTEfISR; 

TABS  ERR ,TRELERR:  LISTR; 


y 
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TKLUST:  LISTI; 
;;l,TKFl<:  INTEGER 


PROCEDURE  RDND2 (RN: INTEGER ; COEF : LISTRPl ; RWR , RW I :LISTR; 

VAR  AEGERR, RELERK:LISTR; VAR  KLUSTrLISTI; 
VAR  KEH:  INTCGI^R)  ; 


VAR  I,J,JP1,JR,K,M,NM1,NP] :  INTEGER; 

1’ ,  CERT  ,  DIET,  EMAC,  MAG,  OEDFRR,P,POlJER,R,  RAT, 
SVR,SVI  ,UNCERT,  VR,  VI  ,  VT ,  X.MAG ,  X I  ,XR:  REAL; 
GNRJtlK:  BOOLEAN; 


FUNCTION  CPABS (XR, YR:REAL) :  REAL; 
BEGIN  (*  CPABS  *) 

CPABS  :=  SQRT (XR*XR+YR*YR) ; 

END;  (*  CPABS  *) 


FUNCTION  AMAXl (A,B: REAL) :  REAL; 
BEGIN  (*  AMAXl  *) 

IF  A<n  THEN 
AMAXl  :=  B 
ELSE 

AMAXl  :=  A; 

END;  (*  AMAXl  *) 


FUNCTION  r.INGLE(VALUE:REAL)  ;  REAL; 
BEGIN  (*  SINGLE  *) 

SINGLE  ;=  VALUE; 

END;  (*  SINGLE  *) 


FUNCTION  DOUBLE (VALUE:REAL) :  REAL; 
BEGIN  (*  DOUBLE  *) 

DOUBLE  :=  VALUE; 

END;  (*  DOUBLE  *) 


ri.’OCEDURi;  SECHALF; 

VAR  J,K:  INTEGER; 

BEGIN  {*  SECHALF  *) 

FOR  J:=l  TO  RN  DO 
BEGIN 
NRITE ( 

KLUSTfJ]  ;=  1; 

XMAG  :=  CPABS  (RWR  [  J]  ,nvJI  [.!)  )  ; 
EMAG  :=  ABSERRIJ]; 

IF  EMAG=0.0  THEN 
i;  :  =  0.0 
ELSE 
BEGIN 

IF  XMAG =0.0  THEN 
R  :=  -1.0 
ELSE 

R  ;=  EMAG/XMAG; 
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END; 

RELF.RR[J]  :=  R; 

END; 

NMl  :=  RN-1; 

FOR  J:=l  TO  NMl  DO 
BEGIN 
VJRITEC 
JPl  :=  J+1; 

FOR  K;=JP1  TO  RN  DO 
BEGIN 

DIST  :=  CPABS(RWR[J]-RWR(K]  ,RWI  [.3]-RU'I  [K]  )  ; 
IF  DIST<=(ABSERR(J]+ABSERR[K] )  THEN 
BEGIN 

KLUST[J]  ;=  KLUGT(J]+1; 

KLUST(Ki  :=  KLUSTlKl+l; 

END; 

END; 

END; 

PER  :=  0; 

END;  {*  SECHALF  *) 


EGIN  (*  KnND2  *) 

WRITELN; 

IF  r;N<l  THEN 
BEGIN 

KER  :=  1; 

WRITELN( 'N (DEGREE)  MUST  RE  >=  1  •  )  ; 
SPACEBAR; 

EXIT; 

END; 

'JPl  :=  RM4  1; 

POWER  :=  1.0/RN; 

P  :  =  ABE  (COEF [1] )  ; 

IF  P=0.0  THEN 
BEGIN 

KER  :=  2; 

WR I  TI:LN  (' LEADING  COEFFICIENT  IS  ZERO. 
SPACEBAR; 

EXIT; 

END; 

RAT  :=  ABS (COEF [NPl 1 ) /P; 

RAT  :=  1:AT*EXP  (  (-4  5. 0)  *LN  (2.0)  )  ; 

FOR  JR;=L  TO  RN  DO 
BEG  Hi 


WRITE  ('...'); 

XR  :  =  DOUBLE (RWR [JR] )  ; 
XI  :  =  DOUBLE  (RVJ I  [  JR]  )  ; 
VR  :=  DOU3LE(0.0)  ; 

VI  : =  DOUBLE (0 . 0)  ; 

FOR  J;=l  TO  NPl  DO 
BEGIN 


WRITE (’...'); 

VT  :=  XR*VR-XI*VJ+DOUBLE(CGEF[J]  )  ; 
VI  :=  XR*VI+XI*VR; 


CND; 

SVR  : =  SINGLE (VH) ; 

SVI  :*  SINGLE (VI) ; 

.lAG  :=  CPABS  (SV1<,SVI)  ; 
n  :=  AMAXl  (RAT,riAG/P)  ; 

RELEiUMJR)  ;=  R; 

ABSERRIJR]  :=  EXP ( POWER*LN (B) ) ; 

END; 

SHRtJJK  :=  FALSE; 

REPEAT 

NRITE 

SIIRUilK  :=  FALSE; 

FCH  J:=l  TO  EN  DO 
BEGIN 

IF  ABSERR(J]  00.0  THEN 
BEGIN 

P  :=  1.0; 

M  :=  RN; 

FOR  K:=l  TO  RN  DO 
BEGIN 
WRITE 

IF  KOJ  THEN 
BEGIN 

DIST  :=  CPABS(RWR[J]-RvvR[K]  ,RWI  [J]-RWI  [K]  )  ; 
UNCERT  :=  ABSERR[K]; 

CERT  :=  DIST-UNCERT; 

IF  CERT>=  ABGERR[J]  THEN 
BEGIN 

P  ;=  P*CERT; 

M  :=  tl-1; 

END; 

END; 

END; 

OLDERR  :=  ABSEKR{J]; 

ABSERRfJ]  :=  RELERR[Jl/P; 

IF  .1>1  THEN 

ABSEERfJ]  :=  EXP ( ( 1 . 0/M) * LN ( ABSERR [ J ] )  )  ; 

IF  ABSERRIJ] <OLDERR*0.99  THEN 
SHRUNK  :=  TRUE; 

END; 

EtJD; 

UNTIL  SHRUNK=FALEE; 

SECHALF; 

EN'D;  (*  I:BND2  *) 

PROCEDURE  RPQR  (RNDEG:  INTEGER;  COEF:  LISTRPl  ;  VAR  I:  I  ERR :  I  NT  EGER  ; 
VAR  RWI ,RWR:L1STR) ; 

VAR  J,K,RLOW,RIGH:  INTEGER; 

Rr;CIP:  REAL; 

RA,RVEC:  MATRIX; 

US:  STRING  I  CO]; 

CM:  CHAR; 

RSCALE:  LISTR; 


RINT:  LISTl 


DEG in  (*  RPCR  *) 

RIERR  :=  0; 

IF  COEFfl]=0  THEN 
EEC  IN 

RIERR  :=  2; 

NRITELN (' LEADING  COEFFICIENT  IS  ZERO  IN  RPQR'); 
SPACEBAR; 

EXIT  ; 

END; 

IF  COEF[1]=0.0  THEN 
RFC  IP  :=  1.0 
ELSE 

RECIP  :=  1.0/COEF[1]; 

FOR  K:=l  TO  RNDEG  DO 
BEGIN 

RA[1,K]  :=  -COEF [K+1 1 *RECIP; 

FOR  J:=2  TO  RNDEG  DO 
RA[J,K]  :=  0.0; 

END; 

FOR  !;:=2  TO  RNDEG  DO 
RA[K,K-1]  :=  1.0; 

BALANCE  (RNDEG,  RNDEG,  RA,  RLOV^,  HIGH,  RSCALE)  ; 

EL, -IHES  (RNDEG, RNDEG, RLOW,RIGll,RA, RINT)  ; 

t: LT  R A N  (  R N D  EG  ,  RN D EG ,  R LOVI ,  R I G H ,  R A  ,  R I  NT  ,  RV EC )  ; 

iIQR2  (  RNDEG  ,  RNDEG  ,  RLOW  ,  R I GIl  ,  RA  ,  KWR ,  RWI  ,  RVEC  ,RI  ERR)  ; 

IE  RIERROO  THEN 

begi:j 

RIERR  1; 

WRITELNCNO  CONVERGENCE  IN  40  QR  ITERATIONS  IN  RPQR'); 
SPACEBAR; 

EXIT; 

END; 

END;  (*  RPQR  *) 

BEGIN  (*  TTRPQR  *) 

CLEARSCREEN; 

REPEAT 

'•.'LEARIT  ( 1)  ; 

Wi;iTE('WHAT  IS  THE  DEGREE  OF  THE  POLYNOMIAL?  '); 

INTREAD (NDEG) ; 

UNTIL  ((NDEOO)  AND  (NDEG<=MAXDEG)  )  ; 

PDEC  ;=  NDEG+1; 

FOR  l:=l  TO  MAXDEGPl  DO 
PRCOEF[I]  :=  0.0; 

CLEARIT (0) ; 

L’RITELN  (' ENTER  COEFFICIENTS  OF  POLYNOMIAL  TERMS:  '); 

NMTEC  '); 

GETE  jLCOE (PDEC, PRCCEF)  ; 

CLEARSCREEN; 

v.-RITiELN  (' PLEASE  VJAIT  '); 

RPOR (NDEG,PRC0EF,TIERR,TW1 ,TWR) ; 

GLEAESCREEN; 

IF  TrERR=0  THEN 
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IttGIN 

jniTELH; 

VJRITCLN  ( 'THE  ARRAY  OF  COMPLEX  ROOTS  IS'); 

VJRITCLN; 

FOR  I:=l  TO  NDEG  DO 
BEGIN 

WRITE ('['); 

WRITE(T'WR[I]  )  ; 

WRITE 

VJRITE  (TWI  [  I  ]  )  ; 

VJRITELN  {']'); 

END; 

WRITELN; 

SPACEBAR; 

RnND2  (;!DEG,PRCOEF,TWR,TV/I  ,  TABSER  R ,  TRELERR ,  TKLUST  ,  TKER) 
WRITELN; 

WRITELtJ  { 'THE  ARRAY  OF  ABSOLUTE  ERRORS  IS'); 

’WRITELN; 

FOR  I:=l  TO  NDEG  DO 
BEGIN 

WRITE { ' [ ' ) ; 

WRITE(TABSERR(I] ) ; 

WRITELN ( ' ] ' ) ; 

END; 

WRITELN; 

SPACEBAR; 

END; 

EtJD;  (*  TTRPQR  *) 


10DEND 


(*  VCRSTO’I  C207  *) 
ilCDULE  OVE[^LAY23; 

EXTTRtJAL  PROCEDURE  GOTOXY  ( X  ,  Y :  1 NTEGER)  ; 
EXTCF^NAL  PROCEDURE  CLEARSCREEN; 

EXTERMAL  PROCEDURE  SPACEBAR; 


PROCEDURE  HELP; 

TYPE  STRUC40  =  STRING[40]; 

VAR  ItJFO:  ARRAY  [1..  12]  OF  STRI'1G40; 

I:  INTEGER; 

BEGIN  (*  HELP  *) 

INL’0[1]  :=  'TO  DO  MATRIX  WORK  ONE  MUST  FIRST  KEY'; 
ItJFO  [2]  :=  'ItJ  A-IIATRIX  "A".  WITH  THIS  ONE  CAN'; 
]IJFO(3]  :=  'CALCULATE  ITS  EIGENVECTORS,  EIGEN-'; 
INFO  [4]  ;=  'VALUES,  INVERSE  OR  DETERMI tJANT .  '; 

Ii;-0(6]  :=  'TO  SOLVE  A  SYSTEM  OF  SIMULTANEOUS  '; 

INFO(7]  :=  'EQUATIONS,  "A"  TIMES  "X"  =  "D",'; 

INFO  [8]  :=  'ONE  MUST  ALSO  KEY  IN  A  MATRIX  "D" . ' ; 

INFO  (5)  :=  '  '; 

INFO [9]  :=  '  •; 

INFO  [10]  :=  'THIS  MATRIX  "3"  MAY  DR  KEYED  IN  AFTER 

INFO [11]  ;=  'THE  MATRIX  "A"  HAS  BEEN  KEYED  IN  AND 

INFO  [12]  :=  'WORKED  WITH. 

CLEARSCREEN; 

GOTOXY (0 , 0) ; 

WRITE( 'DIRECTIONS  FOR  INPUT;  '); 

GOTOXY (0, 3)  ; 

FOE  I:=l  TO  12  DO 
.Jt:ITELN  (INFO  [I]); 

GOTOXY (0,20)  ; 

SPACEP.AR; 

END;  (*  HELP  *) 


MOD END. 


(*  VLUGIOU  0286  *) 

nOOULE  OVCIiLAY24; 

(*  LIGEMVEC  nODULE  *) 

TYPE  DOMAIHl  =  1..20; 

MATRIX  =  ARRAY [DOMAINl ,DOMATta]  OF  REAL; 
LI  ST  I  =  ARRAY  [DOMAIiil]  OF  INTEGER; 

LIGTR  =  ARRAY [DOMAINl]  OF  REAL; 


VAR  lONDIM:  EXTERNAL  INTEGER; 

IOTA,TVEC:  EXTERNAL  MATRIX; 
TEVR,TEV1:  EXTERNAL  LIGTR; 


EXTERNAL  PROCEDURE  CLCARSCREEN; 
EXTERNAL  PROCEDURE  SPACEBAR; 
EXTERNAL  FUNCTION  YEG:  BOOLEAN; 


EXTERNAL  [5]  PROCEDURE  !ICR2  ( NM ,  N »  LOW,  IGIi :  I NTEGCR ;  VAR  U:MATRIX;VAR  WR 

,WI :LISTR; 

VAR  Z:MATRIX;VAR  lERR: INTEGER) ; 

EXTERNAL  [6]  PROCEDURE  BALANCE (NM , N ; INTEGER; VAR  A:MATRIX;VAR  LOW,IGU 

: INTEGER ; 

VAR  SCALErLISTR) ; 


EXTERNAL  [6]  PROCEDURE  ELMUES ( NM , N , LOW , IGU : I NTEGER ; VAR  A:MATRIX;VAR 

INTrLISTI) ; 

EXTERNAL  [6]  PROCEDURE  ELTRAN  ( NM ,  N ,  LOW ,  I GH  :  I  NTEGER ;  VAR  AlMATRIXUN; 

LISTI ; 

VAR  Z ; MATRIX); 

EXTERNAL  [6]  PROCEDURE  BALBAK ( NM , N , LOW , I GH : I NTEGER ; SCALE ; L I STR ; M ; 

INTEGER; 

VAR  Z:MATRIX) ; 


EXTERNAL  [3]  PROCEDURE  HARDCOPY ( HNUM : INTEGER); 


PROCEDURE  TTRNAA; 

VAR  QUITFLAG;  BOOLEAN; 

I  ,.I  ,PDF,G,NDIM:  INTEGER; 
CHOICE, SELECTION:  CHAR; 
•i'COEF;  LISTR; 

T.JI,TWR:  LISTR; 
TIERR,NDDG:  INTEGER; 

Cil:  CHAR; 

GREEL:  STRING; 

P-1:  ItJTEGER; 
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TA;  MATRIX 


PROCROURE  RNAA  (RNDIM,  RN  :  1:JTEGER;VAR  RA  ;  MATE  I  X  ;  VAR  RCVR  ,  REV  I  :  L  I  £TR 
VAR  RVEC:MATRIX;VAR  RIERR: INTEGER) ; 

VAR  G£:  STRING; 

RSCALE:  LISTR; 

PINT:  LISTI; 

I , J,RLOW,RIGH;  INTEGER; 

Cll:  CHAR; 


PROCEDURE  ERRMSS2; 

BEGIN  (*  ERRMSS2  *) 

w'RITLEN  (  '  MORE  THAN  100  QR  ITERATIONS  NEEDED  ’); 

'.JR  I  TEEN  ( 'FOR  SOME  EIGENVALUE  IN  RNAA.'); 

.SPACEBAR; 

EXIT; 

END;  (*  ERRflSS2  *) 

BEGIN  (*  RNAA  *) 

BA  LANC  E ( RND I M , RN , R A , RLOW , R I GH , RSCALE )  ; 

F.LMII ES  ( RND  IM ,  RN  ,  RLOiJ  ,RIGH,RA,RINT); 

ELTRAN  (RNDIM,RN,RLOH,RIGIl,  RA,RINT,RVEC)  ; 

HQi;2  (RNDIM,RN,RLOW,RIGll,RA,REVR,REVI  ,RVEC,RIERR)  ; 

IF  (RIERROO)  THEN 
EURMSS2; 

BALBAK  (RNDIM,  RN,  FLOW,  R I  GIl,  RSCALE,  RN,RVEC)  ; 

END;  (*  RNAA  *) 

PRCCEDURE  PRVECTORS; 

VAR  I:  INTEGER; 

BEGIN  {*  PRVECTORS  *) 

J  :=  1; 

REPEAT 

IF  TEVI  (J]  00.0  THEN 
BEGIN 

WBITELN ( 'VECTOR  ',J,'  HAS  COMPONENTS  '); 

FOR  I;=l  TO  NDIM  DO 
BEGIN 

VJRITE  (  'VECTOR'  ,  J  ,'(',  I  '  ,TVEC  (  I  ,  J]  )  ; 

WRITELN  (  '  ,  '  ,TVEC ( I , J  +  1 ],’]’)  J 
END; 

LK'ITELN; 

.SPACEBAR; 

NRITELN; 

WRITELN ( 'VECTOR  ',J+1,'  HAS  COMPONENTS  '); 

FOR  l:=l  TO  NDIM  DO 
BEGIN 

WRITE  (  'VECTOR'  ,J+1,'[', I, ,TVi;C  [  I  ,  J]  )  ; 
WRITELN  (  '  , '  ,-TVEC  (1,0+11,']'); 

END; 


VJRITELN; 

J  :  =  J  +  2  f 
END 
ELSE 
BEGIN 

WRITELN  (  '  VECTCr;  ',J,*  HAS  COMPONENTS  '  )  ; 

FOR  I:=l  TO  NDIiM  DO 
BEGItl 

WRITE ( 'VECTOR' I, ,TVCC [ I , J] ) 
WRITELN ( ' ,O.OOOOOOOOOOOOOOE  +  O00]  '  )  ; 

END; 

J  :=  J+1; 

END; 

SPACCnAR; 

WRITELN; 

UNTIL  J>HDIM; 

Et!D;  (*  PRVECTORS  *) 


nLGIM(*  TTRNAA  *) 

CLEARSCRECN; 
tiSI.T  :=  lONOIM; 

FOR  I : =1  TO  NDIM  DO 
FOR  J:=l  TO  NDIM  DO 
TA[I,J1  :=  IOTA[I,J] ; 
cle; RGCREEN; 

WRITE (' PLEASE  WAIT...'); 

RfJAA  ( f;D  I M  ,  NDIM,  TA  ,  TEVR  ,  TEVI  ,  TVEC  ,T  I  ERR)  ; 
CLEARoCREEN; 

WRITELN (' THE  ARRAY  OF  COMPLEX  EIGENVALUES  IS'); 
WR  I  TELti; 

FOR  T;=l  TO  NDIM  DO 
BEGIN 

WRITE! '  I ' ) ; 

WRITE (TEVR  [  I ] )  ; 

■WRITE!  '  ,  '  )  ; 

w'nrri:  (TEVI  ( i  ] )  ; 

..Mil  TEEN  !']'); 

END; 

WRITELN; 

SPACLU.AF. ; 

WHITLLN; 

VM  ITELN ( ' THE  COMPLEX  EIGENVECTORS  ARE  '); 

WR  iTCLr:; 

PRVI.CTORS; 

WRITELN ; 

WRIIE!'DO  YOU  WANT  A  IIAliD  COPY?  Y/N  '); 

IF  YI’.S  THEN 
ll.TKOCOPY  ( 1)  ; 

END;  (*  TTRN.AA  *) 

MWD r.NW  . 
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